Eksploracyjna analiza danych | Inżynieria i Analiza Danych

Case Study

Dataset koronawirus

Hierarchiczna analiza skupień

Mateusz Bugdol
Nr indeksu: 419719
Grupa ćwiczeniowa: 1

1. Wstęp i cel case study.

W ramach projektu zaliczeniowego (Case Study) przeanalizowany zostanie wylosowany zbiór danych dotyczący rozprzestrzeniania się koronawirusa. Celem pracy jest wykorzystanie metod uczenia nienadzorowanego, a konkretnie hierarchicznej analizy skupień, do znalezienia ukrytych struktur w danych. Raport przedstawia proces przygotowania danych, przebieg analizy oraz interpretację uzyskanych klastrów.

2. Pakiety

W tej sekcji załadowane zostaną niezbędne biblioteki:

library(tidyverse)
library(dplyr)
library(cluster)
library(factoextra)
library(ggplot2)
library(DataExplorer)
library(sf)
library(viridis) 
library(tidyr)
library(plotly)
library(treemapify)
library(scales)
library(corrplot)
library(caret)
library(fpc)

3. Preprocessing danych

Wczytanie danych

Zbiór danych coronavirus_dataset.csv zawiera szczegółowe, dzienne od 22 stycznia 2020 roku do 16 marca 2020 roku. Statystyki dotyczą rozprzestrzeniania się pandemii COVID-19 w większości krajów na świecie. Dane są zorganizowane w formacie „długim” (long format), gdzie każdy wiersz stanowi pojedynczy rekord dla konkretnej daty, lokalizacji oraz typu przypadku.

df = read.csv2("../data/coronavirus_dataset.csv", header = T, sep = ",", na.strings = c("", "NA"))
head(df)
##   Province.State Country.Region Lat Long       date cases      type
## 1           <NA>    Afghanistan  33   65 2020-01-22     0 confirmed
## 2           <NA>    Afghanistan  33   65 2020-01-23     0 confirmed
## 3           <NA>    Afghanistan  33   65 2020-01-24     0 confirmed
## 4           <NA>    Afghanistan  33   65 2020-01-25     0 confirmed
## 5           <NA>    Afghanistan  33   65 2020-01-26     0 confirmed
## 6           <NA>    Afghanistan  33   65 2020-01-27     0 confirmed

Zmienne zawarte w zbiorze:

W celu pogłębienia analizy, podstawowy zbiór danych COVID-19 został wzbogacony o zewnętrzne dane demograficzne pochodzące z portalu United Nations (https://population.un.org/dataportal/data). Dołączony zbiór onz_data.csv zawiera informacje o populacji, gęstości zaludnienia (osoby na kilometr kwadratowy) oraz medianie wieku pochodzące z roku 2019 (stan przed pandemią). Pozwoli to na normalizację statystyk zachorowań oraz zbadanie wpływu struktury demograficznej na przebieg pandemii.

df_onz = read.csv("../data/onz_data.csv", header = T, stringsAsFactors = FALSE)
head(df_onz)
##          Country Iso3 Population   Density MedianAge
## 1    Afghanistan  AFG 37856121.0  58.30333  16.23426
## 2        Albania  ALB  2885009.5 105.30000  34.70803
## 3        Algeria  DZA 43294546.0  18.17770  27.43115
## 4 American Samoa  ASM    50209.0 251.04500  26.25127
## 5        Andorra  AND    76473.5 162.70957  41.73090
## 6         Angola  AGO 32375632.5  25.96906  16.30242

Zmienne zawarte w zbiorze:

Poprawność struktury danych

Przed przystąpieniem do dalszej obróbki i agregacji danych, konieczne jest sprawdzenie, w jaki sposób zinterpretowano poszczególne kolumny podczas importu. Automatyczne wczytywanie plików CSV czasami błędnie przypisuje typy danych, traktując liczby lub daty jako ciągi znaków, co uniemożliwia wykonywanie na nich operacji matematycznych wymaganych w analizie skupień. Poniższy kod weryfikuje klasy atrybutów oraz dokonuje niezbędnych korekt.

sapply(df, class)
## Province.State Country.Region            Lat           Long           date 
##    "character"    "character"    "character"    "character"    "character" 
##          cases           type 
##      "integer"    "character"

Wstępna analiza struktury danych wykazała, że zmienne geograficzne Lat (szerokość) i Long (długość) oraz zmienna date zostały pierwotnie zinterpretowane jako typ tekstowy (character).

df$Lat = as.numeric(df$Lat)
df$Long = as.numeric(df$Long)
df$date = as.Date(df$date)

Dokonano jasnej kowersji danych:

sapply(df, class)
## Province.State Country.Region            Lat           Long           date 
##    "character"    "character"      "numeric"      "numeric"         "Date" 
##          cases           type 
##      "integer"    "character"
sapply(df_onz, class)
##     Country        Iso3  Population     Density   MedianAge 
## "character" "character"   "numeric"   "numeric"   "numeric"

Analiza struktury danych zbioru df_onz wskazuje, że zmienne zostały wczytane z poprawnymi typami danych. Zmienne identyfikacyjne Country i Iso3 są typu tekstowego (character), natomiast kluczowe zmienne demograficzne: Population, Density oraz MedianAge, które posłużą do dalszej analizy statystycznej i klastrowania, zostały prawidłowo zinterpretowane jako typ numeryczny (numeric).

Czyszczenie i selekcja

Kluczowym etapem preprocessingu jest identyfikacja i obsługa brakujących wartości. Pozostawienie ich bez ingerencji mogłoby prowadzić do błędów podczas agregacji lub obliczania macierzy odległości.

plot_missing(df)

Jak widać na wygenerowanym wykresie, kolumna Province.State charakteryzuje się bardzo wysokim odsetkiem brakujących danych. Wynika to ze specyfiki raportowania – większość państw w zbiorze podaje statystyki ogólnokrajowe, a jedynie nieliczne (jak USA, Chiny czy Kanada) są rozbite na mniejsze jednostki administracyjne.

df$Province.State <- NULL

Ponieważ celem niniejszego badania jest porównanie efektywności walki z pandemią na poziomie całych państw, a nie poszczególnych regionów, zmienna ta jest zbędna. Jej usunięcie pozwoli na wyeliminowanie całkowite brakujących wartości oraz uproszczenie procesu ewentualnej agregacji danych.

Inżynieria danych (Feature Engineering)

Oryginalny zbiór danych posiada strukturę szeregów czasowych, gdzie każdy dzień jest osobnym rekordem. Aby przeprowadzić hierarchiczną analizę skupień, w której obiektem badanym jest kraj, konieczne jest sprowadzenie danych do postaci, gdzie jeden wiersz odpowiada jednemu państwu.

Zanim jednak przystąpimy do tej transformacji, musimy przygotować grunt pod połączenie danych epidemicznych ze zmiennymi demograficznymi z bazy ONZ (df_onz). Kluczowym wyzwaniem jest tu niespójność w nazewnictwie krajów pomiędzy zbiorami. W pierwszej kolejności identyfikujemy państwa z bazy COVID-owej (df), których nazwy nie pasują do tych w bazie ONZ.

setdiff(df$Country.Region, df_onz$Country)
##  [1] "Bolivia"                        "Brunei"                        
##  [3] "Congo (Brazzaville)"            "Congo (Kinshasa)"              
##  [5] "Cote d'Ivoire"                  "Holy See"                      
##  [7] "Iran"                           "Korea, South"                  
##  [9] "Kosovo"                         "Moldova"                       
## [11] "occupied Palestinian territory" "Republic of the Congo"         
## [13] "Reunion"                        "Russia"                        
## [15] "Taiwan*"                        "Tanzania"                      
## [17] "The Bahamas"                    "Turkey"                        
## [19] "Venezuela"                      "Vietnam"                       
## [21] "US"                             "Cruise Ship"

Analiza wykazała szereg rozbieżności. Aby umożliwić poprawne złączenie tabel (join), dokonujemy ręcznej standaryzacji nazw w zbiorze df_onz, dostosowując je do konwencji przyjętej w danych COVIDowych.

df_onz <- df_onz %>%
  mutate(Country = recode(
    Country,
    "Bolivia (Plurinational State of)"      = "Bolivia",
    "Brunei Darussalam"                     = "Brunei",
    "Congo"                                 = "Congo (Brazzaville)",
    "Democratic Republic of the Congo"      = "Congo (Kinshasa)",
    "Côte d'Ivoire"                         = "Cote d'Ivoire",
    "Vatican City"                          = "Holy See",
    "Iran (Islamic Republic of)"            = "Iran",
    "Republic of Korea"                     = "Korea, South",
    "Republic of Moldova"                   = "Moldova",
    "Russian Federation"                    = "Russia",
    "United Republic of Tanzania"           = "Tanzania",
    "Bahamas"                               = "The Bahamas",
    "Türkiye"                               = "Turkey",
    "Venezuela (Bolivarian Republic of)"    = "Venezuela",
    "Viet Nam"                              = "Vietnam",
    "United States of America"              = "US",
    "Kosovo (under UNSC res. 1244)"         = "Kosovo",
    "State of Palestine"                    = "occupied Palestinian territory",
    "Réunion"                               = "Reunion",
    "China, Taiwan Province of China"       = "Taiwan*"
  ))  
setdiff(df$Country.Region, df_onz$Country)
## [1] "Holy See"              "Republic of the Congo" "Cruise Ship"

Wynik funkcji setdiff wskazuje kraje z bazy COVID (df), które nie znalazły odpowiednika w bazie demograficznej (df_onz). Zostaną one pominięte w dalszej analizie (klastrowaniu) z następujących powodów:

df_agg <- df %>%
  group_by(Country.Region, type) %>%
  summarise(
    cases = sum(cases),
    Lat  = mean(Lat),
    Long = mean(Long),
    .groups = "drop"
  )

Dokonano agregacji danych, przekształcając szczegółowe zapisy dzienne w ogólne podsumowanie dla każdego kraju. Zsumowano liczbę przypadków dla poszczególnych typów zdarzeń, uzyskując całkowity bilans pandemii.

df_wide <- df_agg %>%
  pivot_wider(
    names_from   = type,
    values_from  = cases,
    names_prefix = "Total_",
    values_fill  = 0
  )

Przekształcono strukturę danych z formatu “długiego” (long) na “szeroki” (wide). Zamiast kilku wierszy dla tego samego kraju (osobno dla zakażeń, zgonów i wyzdrowień), utworzono jeden unikalny rekord dla każdego państwa, w którym poszczególne statystyki stały się osobnymi kolumnami:

Ułatwia to dalszą analizę, gdyż wszystkie informacje o danym kraju znajdują się teraz w jednym wierszu.

df_final <- df_wide %>%
  left_join(
    df_onz,
    by = c("Country.Region" = "Country")
  ) %>%
  mutate(
    Total_stillSick = Total_confirmed - Total_recovered - Total_death,

    Mortality_Rate = ifelse(
      Total_confirmed > 0,
      Total_death / Total_confirmed,
      0
    ),

    Recovery_Rate = ifelse(
      Total_confirmed > 0,
      Total_recovered / Total_confirmed,
      0
    ),
    
    Active_Rate = ifelse(
      Total_confirmed > 0,
      Total_stillSick / Total_confirmed,
      0
    ),

    Incidence_Rate = (Total_confirmed / Population),
    Mortality_per_capita = (Total_death / Population),
    StillSick_per_capita = (Total_stillSick / Population)
  ) %>%
  filter(is.finite(Incidence_Rate)) %>%
  na.omit()

Połączono zagregowane dane epidemiczne z danymi demograficznymi (zbiór ONZ), a następnie przeprowadzono inżynierię cech (feature engineering). Stworzenie wskaźników relatywnych pozwala na obiektywne porównanie sytuacji w krajach o drastycznie różnej liczbie ludności.

Do zbioru dodano następujące zmienne:

Finalnie zbiór oczyszczono z wartości nieskończonych oraz rekordów niekompletnych, przygotowując go bezpośrednio do modelowania.

head(df_final)
## # A tibble: 6 × 17
##   Country.Region    Lat   Long Total_confirmed Total_death Total_recovered Iso3 
##   <chr>           <dbl>  <dbl>           <int>       <int>           <int> <chr>
## 1 Afghanistan      33    65                 21           0               1 AFG  
## 2 Albania          41.2  20.2               51           1               0 ALB  
## 3 Algeria          28.0   1.66              54           4              12 DZA  
## 4 Andorra          42.5   1.52               2           0               1 AND  
## 5 Antigua and Ba…  17.1 -61.8                1           0               0 ATG  
## 6 Argentina       -38.4 -63.6               56           2               1 ARG  
## # ℹ 10 more variables: Population <dbl>, Density <dbl>, MedianAge <dbl>,
## #   Total_stillSick <int>, Mortality_Rate <dbl>, Recovery_Rate <dbl>,
## #   Active_Rate <dbl>, Incidence_Rate <dbl>, Mortality_per_capita <dbl>,
## #   StillSick_per_capita <dbl>

W wyniku powyższych operacji otrzymano ramkę danych df_final, która stanowi bazę do właściwej analizy skupień.

4. Eksploracyjan analiza danych (EDA)

W tej sekcji przyjrzymy się bliżej rozkładom zmiennych, relacjom między nimi oraz rozmieszczeniu geograficznemu pandemii przed przystąpieniem do grupowania.

temp <- df_final %>%
  summarise(
    Aktywne = sum(Total_stillSick, na.rm = TRUE),
    Wyzdrowiali = sum(Total_recovered, na.rm = TRUE),
    Zgony = sum(Total_death, na.rm = TRUE)
  ) %>%
  pivot_longer(cols = everything(), names_to = "variable", values_to = "value") %>%
  mutate(label = paste(variable, "\n", format(value, big.mark = " ", scientific = FALSE)))

custom_colors <- c("Aktywne" = "#febd52", "Zgony" = "#d05050", "Wyzdrowiali" = "#43a047")

ggplot(temp, aes(area = value, fill = variable, label = label)) +
  geom_treemap() +
  geom_treemap_text(
    colour = "white",
    place = "centre",
    grow = FALSE,
    reflow = TRUE
  ) +
  scale_fill_manual(values = custom_colors) +
  theme(legend.position = "none",
        plot.title = element_text(hjust = 0.5)) +
  labs(title = "Suma zakażeń, śmierci i uleczeń spowodowanych przez\nCOVID-19 od 22 stycznia do 16 marca 2020 roku")

Wizualizacja przedstawia strukturę globalnego bilansu pandemii w okresie od 22 stycznia do 16 marca 2020 roku. Największą powierzchnię zajmują przypadki aktywne (ponad 95 tysięcy), co wskazuje na dynamiczny rozwój epidemii w tym czasie, przewyższając liczbę osób wyzdrowiałych (blisko 78 tysięcy). Zgony stanowią najmniejszy odsetek wszystkich odnotowanych zdarzeń, obejmując nieco ponad 7 tysięcy przypadków.

matter_colors <- c(
  "#f0fa92", "#f8e97a", "#fcd363", "#febd52", "#fea848", 
  "#fb9342", "#f48043", "#ea6e46", "#de5e4b", "#d05050", 
  "#c04455", "#af3a58", "#9d325a", "#8b2b59", "#782556", 
  "#661f52", "#541a4c", "#431545", "#32103d", "#220b34"
)

plot_map <- function(df, col, title = col, legend_title = col) {
  df_filtered <- df[df[[col]] >= 0, ]
  
  fig <- plot_geo(df_filtered) %>%
    add_trace(
      z = df_filtered[[col]],
      locations = df_filtered$Iso3,
      locationmode = "ISO-3",
      colors = matter_colors,
      text = paste(df_filtered$Country.Region, "\n", legend_title, ":", df_filtered[[col]]),
      hovertemplate = "%{text}<extra></extra>",
      marker = list(line = list(color = toRGB("grey"), width = 0.5)),
      showlegend = FALSE
    ) %>%
    add_trace(
      type = "scattergeo",
      mode = "markers",
      lat = NA,
      lon = NA,
      marker = list(color = toRGB("gray90"), size = 10, symbol = "square"),
      name = "Brak danych",
      showlegend = TRUE
    ) %>%
    colorbar(title = legend_title) %>%
    layout(
      title = title,
      geo = list(
        showframe = TRUE,
        framecolor = toRGB("grey"),
        showcoastlines = TRUE,
        projection = list(type = 'mercator'),
        showland = TRUE,
        landcolor = toRGB("gray90"),
        showcountries = TRUE,
        countrycolor = toRGB("white")
      )
    )
  
  return(fig)
}
plot_map(df_final, 
         col = 'Total_confirmed', 
         title = "Całkowita liczba potwierdzonych przypadków", 
         legend_title = "Liczba osób")

Mapa świata obrazuje przestrzenny rozkład całkowitej liczby potwierdzonych przypadków COVID-19, gdzie intensywność koloru odpowiada skali zachorowań. Zdecydowanie wyróżniają się Chiny jako główne ognisko pandemii z liczbą zakażeń zbliżoną do 80 tysięcy, podczas gdy w pozostałych regionach, z wyjątkiem widocznych ognisk we Włoszech i Iranie, liczba odnotowanych przypadków jest wielokrotnie niższa.

plot_map(df_final, 
         col = 'Total_death', 
         title = "Całkowita liczba zgonów", 
         legend_title = "Liczba zgonów")

Mapa prezentuje globalne rozmieszczenie liczby zgonów spowodowanych przez COVID-19, gdzie najciemniejszy kolor wskazuje regiony o najwyższej śmiertelności. Podobnie jak w przypadku liczby zakażeń, tragiczny bilans dominuje w Chinach, jednak wyraźnie widoczne są również nowe, intensywne ogniska epidemii we Włoszech oraz w Iranie, które znacząco wyróżniają się na tle pozostałych państw.

plot_map(df_final, 
         col = 'Total_recovered', 
         title = "Całkowita liczba wyzdrowień", 
         legend_title = "Liczba wyzdrowień")

Mapa obrazuje globalny rozkład liczby wyzdrowień, gdzie – analogicznie do liczby zakażeń – dominują Chiny, co wynika z wcześniejszego rozwoju epidemii w tym regionie. Ciemny kolor wskazuje na wysoką liczbę pacjentów, którzy zwalczyli infekcję (skala do 60 tys.), podczas gdy w pozostałych częściach świata, w tym w rozwijających się ogniskach w Europie i na Bliskim Wschodzie, liczba odnotowanych wyzdrowień jest na tym etapie jeszcze stosunkowo niska.

plot_map(df_final, 
         col = 'Total_stillSick', 
         title = "Aktywne przypadki (wciąż chorzy)", 
         legend_title = "Aktywne przypadki")

Mapa prezentująca liczbę aktywnych przypadków na dzień 16 marca 2020 roku ukazuje istotną zmianę w dynamice przebiegu pandemii. W przeciwieństwie do mapy zakażeń całkowitych, tutaj głównym epicentrum są Włochy (oznaczone najciemniejszym kolorem), co wskazuje na gwałtowny przyrost chorych w Europie, podczas gdy w Chinach liczba aktywnych infekcji wyraźnie spadła na skutek dużej liczby wyzdrowień. Widoczny jest również rosnący trend zachorowań w Stanach Zjednoczonych, Iranie, Hiszpanii, Francji i Niemczech.

iso_map <- df_final %>%
  select(Country.Region, Iso3) %>%
  distinct()

df_anim <- df %>%
  filter(type == "confirmed") %>%
  group_by(Country.Region, date) %>%
  summarise(day_cases = sum(cases, na.rm = TRUE), .groups = "drop") %>%
  left_join(iso_map, by = "Country.Region") %>%
  filter(!is.na(Iso3)) %>%
  arrange(Country.Region, date) %>%
  group_by(Country.Region) %>%
  mutate(
    total_cases = cumsum(day_cases),
    date_str = as.character(date)
  ) %>%
  ungroup()

max_total_cases <- max(df_anim$total_cases, na.rm = TRUE)

plot_geo(df_anim) %>%
  add_trace(
    z = ~total_cases,
    locations = ~Iso3,
    locationmode = "ISO-3",
    frame = ~date_str,
    colors = matter_colors,
    text = ~paste(Country.Region, "\nData:", date_str, "\nSuma narastająco:", total_cases),
    hoverinfo = "text",
    marker = list(line = list(color = toRGB("grey"), width = 0.5)),
    zmin = 0,
    zmax = max_total_cases
  ) %>%
  colorbar(title = "Suma przypadków") %>%
  layout(
    title = "Rozwój pandemii",
    geo = list(
      showframe = FALSE,
      showcoastlines = TRUE,
      projection = list(type = 'mercator'),
      showland = TRUE,
      landcolor = toRGB("gray90"),
      showcountries = TRUE
    )
  ) %>%
  animation_opts(
    frame = 100, 
    transition = 0, 
    redraw = FALSE
  )

Animowana wizualizacja obrazuje dynamikę rozprzestrzeniania się zakażeń na świecie w okresie od 22 stycznia do 16 marca 2020 roku. Początkowym epicentrum pandemii były Chiny, gdzie do połowy lutego potwierdzono ponad 70 tysięcy przypadków, podczas gdy w innych krajach (np. Japonii czy Korei Południowej) liczby te pozostawały marginalne. Sytuacja uległa istotnej zmianie na przełomie lutego i marca, kiedy to nastąpił gwałtowny wzrost zachorowań w nowych ogniskach epidemii: we Włoszech oraz Iranie.

data_cumulative <- df %>%
  filter(type %in% c("confirmed", "death", "recovered")) %>%
  group_by(date, type) %>%
  summarise(daily_cases = sum(cases, na.rm = TRUE), .groups = "drop") %>%
  arrange(date) %>%
  group_by(type) %>%
  mutate(total = cumsum(daily_cases)) %>%
  ungroup() %>%
  mutate(
    type_label = case_when(
      type == "confirmed" ~ "Potwierdzone",
      type == "recovered" ~ "Wyzdrowienia",
      type == "death" ~ "Zgony"
    ),
    type_label = factor(type_label, levels = c("Potwierdzone", "Wyzdrowienia", "Zgony"))
  )

custom_colors <- c(
  "Potwierdzone" = "#febd52",
  "Wyzdrowienia" = "#43a047",
  "Zgony"        = "#d05050"
)

ggplot(data_cumulative, aes(x = date, y = total, fill = type_label)) +
  geom_area(alpha = 0.6, position = "identity") +
  scale_fill_manual(values = custom_colors) +
  scale_y_continuous(labels = scales::label_number(scale_cut = scales::cut_short_scale())) +
  theme_minimal() +
  labs(
    title = "Łączna liczba przypadków w czasie",
    x = "Data",
    y = "Liczba przypadków",
    fill = "Typ"
  ) +
  theme(legend.position = "top")

Wykres warstwowy obrazuje kumulacyjny przyrost liczby przypadków COVID-19 w czasie, z podziałem na potwierdzone zakażenia, wyzdrowienia oraz zgony. Widoczna jest stała tendencja wzrostowa całkowitej liczby chorych (obszar żółty), która ulega wyraźnemu przyspieszeniu w marcu, co świadczy o globalnej ekspansji wirusa. Równolegle obserwowany jest systematyczny wzrost liczby osób, które zwalczyły infekcję (obszar zielony), podczas gdy odsetek zgonów (wąski pasek czerwony) pozostaje stabilny i niski w stosunku do ogólnej liczby zachorowań.

plot_map(df_final, 
         col = 'Mortality_Rate', 
         title = "Wskaźnik śmiertelności wśród zarażonych na COVID-19", 
         legend_title = "Odsetek zgonów")

Mapa przedstawia przestrzenny rozkład wskaźnika śmiertelności (CFR), obliczonego jako stosunek liczby zgonów do liczby potwierdzonych przypadków. W przeważającej części świata współczynnik ten utrzymuje się na niskim poziomie, co reprezentują jasne odcienie, natomiast wyraźnym wyjątkiem jest Sudan oznaczony najciemniejszą barwą, co wskazuje na drastycznie wysoki odsetek zgonów w stosunku do wykrytych infekcji (co często wynika z małej liczby testów na wczesnym etapie epidemii).

plot_map(df_final, 
         col = 'Recovery_Rate', 
         title = "Wskaźnik wyzdrowień wśród zarażonych na COVID-19", 
         legend_title = "Odsetek wyzdrowień")

Mapa prezentuje przestrzenny rozkład wskaźnika wyzdrowień, zdefiniowanego jako udział osób wyleczonych w całkowitej liczbie potwierdzonych przypadków. Najwyższe wartości (ciemny kolor) obserwowane są w Chinach, co wynika z faktu, że jako pierwsze ognisko pandemii, kraj ten zdążył już odnotować dużą liczbę zamkniętych, wyleczonych spraw. W pozostałych regionach, gdzie pandemia była w fazie początkowego rozwoju (np. Europa, USA), wskaźnik ten pozostaje niski (jasne kolory), co oznacza, że większość zdiagnozowanych pacjentów była wciąż w trakcie choroby.

plot_map(df_final, 
         col = 'Incidence_Rate', 
         title = "Wskaźnik zachorowalności", 
         legend_title = "Przypadki")

Mapa obrazuje rozkład wskaźnika zachorowalności, który normalizuje liczbę zakażeń względem populacji danego kraju. Zastosowanie tej miary zmienia perspektywę oceny zagrożenia – o ile w liczbach bezwzględnych dominowały Chiny, to w ujęciu relatywnym (na mieszkańca) najciemniejszymi kolorami wyróżniają się Włochy oraz Islandia, co wskazuje na najwyższą penetrację wirusa w strukturze tych społeczeństw w analizowanym okresie.

plot_map(df_final, 
         col = 'Mortality_per_capita', 
         title = "Wskaźnik zgonów na mieszkańca", 
         legend_title = "Zgony")

Mapa prezentuje wskaźnik umieralności w przeliczeniu na jednego mieszkańca, co pozwala ocenić rzeczywiste obciążenie demograficzne w poszczególnych państwach. W tym ujęciu punkt ciężkości pandemii wyraźnie przesuwa się do Europy – najciemniejszym kolorem wyróżniają się Włochy, gdzie relacja liczby zgonów do wielkości populacji była w badanym okresie najwyższa na świecie, znacznie przewyższając wartości notowane w Chinach.

plot_map(df_final, 
         col = 'StillSick_per_capita', 
         title = "Wskaźnik aktywnych przypadków na mieszkańca", 
         legend_title = "Aktywni")

Mapa przedstawia rozkład wskaźnika aktywnych przypadków w przeliczeniu na populację, co pozwala zidentyfikować regiony o najwyższym bieżącym obciążeniu epidemiologicznym. W tym ujęciu epicentrum pandemii znajduje się w Europie – najciemniejszymi barwami wyróżniają się Włochy oraz Islandia, gdzie odsetek osób wciąż chorujących względem liczby mieszkańców był w analizowanym momencie najwyższy, podczas gdy w Chinach wskaźnik ten spadł do niskiego poziomu dzięki dużej liczbie wyzdrowień.

heatmap_data <- df %>%
  filter(type == "confirmed") %>%
  group_by(Country.Region, date) %>%
  summarise(daily_cases = sum(cases, na.rm = TRUE), .groups = "drop") %>%
  mutate(
    status = ifelse(daily_cases > 0, "1", "0"),
    status = factor(status, levels = c("0", "1"))
  )

heatmap_colors <- c("0" = "#e5f5e0", "1" = "#006d2c")

ggplot(heatmap_data, aes(x = date, y = Country.Region, fill = status)) +
  geom_tile(color = "white", linewidth = 0.05) +
  scale_fill_manual(
    values = heatmap_colors,
    labels = c("Brak przypadków", "Odnotowano zachorowania"),
    name = "Status"
  ) +
  scale_x_date(
    date_labels = "%d %b",
    date_breaks = "1 week",
    expand = c(0, 0)
  ) +
  scale_y_discrete(limits = rev) +
  labs(
    title = "Analiza występowania zakażeń COVID-19 wg krajów w pierwszych 2 miesiącach pandemii",
    x = "Data",
    y = "Kraj"
  ) +
  theme_minimal() +
  theme(
    axis.text.y = element_text(size = 9), 
    axis.text.x = element_text(angle = 90, vjust = 0.5, hjust = 1, size = 10),
    legend.position = "top",
    panel.grid = element_blank(),
    plot.title = element_text(size = 20),
    plot.subtitle = element_text(size = 14)
  )

Wykres w formie binarnej mapy ciepła prezentuje chronologię występowania nowych przypadków COVID-19, gdzie ciemnozielony kolor oznacza odnotowanie zakażenia w danym dniu. Wizualizacja kontrastuje ciągły przebieg epidemii w Chinach z resztą świata, gdzie początkowo widoczne są jedynie sporadyczne ogniska, które w połowie marca gwałtownie ewoluują w systematyczne, codzienne zachorowania w niemal wszystkich analizowanych państwach, obrazując globalną ekspansję pandemii.

summary(df_final)
##  Country.Region          Lat              Long         Total_confirmed
##  Length:153         Min.   :-40.90   Min.   :-102.55   Min.   :    0  
##  Class :character   1st Qu.:  7.54   1st Qu.:  -9.43   1st Qu.:    4  
##  Mode  :character   Median : 24.00   Median :  18.49   Median :   25  
##                     Mean   : 23.14   Mean   :  15.02   Mean   : 1182  
##                     3rd Qu.: 42.60   3rd Qu.:  45.04   3rd Qu.:  142  
##                     Max.   : 71.71   Max.   : 174.89   Max.   :81033  
##   Total_death      Total_recovered       Iso3             Population       
##  Min.   :   0.00   Min.   :    0.0   Length:153         Min.   :3.465e+04  
##  1st Qu.:   0.00   1st Qu.:    0.0   Class :character   1st Qu.:2.650e+06  
##  Median :   0.00   Median :    0.0   Mode  :character   Median :9.435e+06  
##  Mean   :  46.53   Mean   :  508.3                      Mean   :4.770e+07  
##  3rd Qu.:   1.00   3rd Qu.:    3.0                      3rd Qu.:3.344e+07  
##  Max.   :3217.00   Max.   :67910.0                      Max.   :1.424e+09  
##     Density            MedianAge     Total_stillSick   Mortality_Rate    
##  Min.   :1.366e-01   Min.   :14.37   Min.   :    0.0   Min.   :0.000000  
##  1st Qu.:4.463e+01   1st Qu.:24.84   1st Qu.:    3.0   1st Qu.:0.000000  
##  Median :9.792e+01   Median :31.21   Median :   25.0   Median :0.000000  
##  Mean   :4.145e+02   Mean   :31.73   Mean   :  627.2   Mean   :0.020470  
##  3rd Qu.:2.402e+02   3rd Qu.:39.80   3rd Qu.:  121.0   3rd Qu.:0.006803  
##  Max.   :2.558e+04   Max.   :54.64   Max.   :23073.0   Max.   :1.000000  
##  Recovery_Rate      Active_Rate     Incidence_Rate      Mortality_per_capita
##  Min.   :0.00000   Min.   :0.0000   Min.   :0.000e+00   Min.   :0.000e+00   
##  1st Qu.:0.00000   1st Qu.:0.9310   1st Qu.:6.142e-07   1st Qu.:0.000e+00   
##  Median :0.00000   Median :0.9918   Median :3.992e-06   Median :0.000e+00   
##  Mean   :0.05612   Mean   :0.9169   Mean   :5.300e-05   Mean   :1.818e-06   
##  3rd Qu.:0.03670   3rd Qu.:1.0000   3rd Qu.:2.550e-05   3rd Qu.:5.847e-08   
##  Max.   :1.00000   Max.   :1.0000   Max.   :3.145e-03   Max.   :2.020e-04   
##  StillSick_per_capita
##  Min.   :0.000e+00   
##  1st Qu.:5.987e-07   
##  Median :3.714e-06   
##  Mean   :4.851e-05   
##  3rd Qu.:1.944e-05   
##  Max.   :2.828e-03

Analiza statystyk opisowych dla 153 krajów rozpoczyna się od wskaźników określających bezwzględną skalę pandemii, obejmujących całkowitą liczbę potwierdzonych zakażeń, zgonów, wyzdrowień oraz aktywnych przypadków. Rozkład tych danych charakteryzuje się silną asymetrią prawostronną, gdzie średnie wartości są wielokrotnie wyższe od median. Przykładowo, mimo średniej wynoszącej ponad 1100 infekcji, typowy kraj odnotował ich zaledwie 25, a w przypadku ofiar śmiertelnych i ozdrowieńców w ponad połowie państw wartości te wciąż wynoszą zero. Tło demograficzne analizy tworzą dane dotyczące populacji, gęstości zaludnienia i mediany wieku, które ukazują ogromną różnorodność badanych jednostek – począwszy od wielomiliardowych mocarstw po małe terytoria oraz od społeczeństw bardzo młodych (wiek środkowy 14 lat) do starzejących się (ponad 54 lata). Obraz dopełniają wskaźniki relatywne, takie jak stopa śmiertelności (średnio ok. 2%) i wskaźnik wyzdrowień (średnio 5,6%) oraz współczynniki przeliczone na mieszkańca (zapadalność i umieralność), które przyjmują bardzo niskie wartości liczbowe, co precyzyjnie odzwierciedla wczesny etap rozwoju pandemii w większości regionów świata.

ggplot(df_final, aes(x = Total_confirmed)) +
  geom_histogram(bins = 50, fill = "steelblue", color = "white", alpha = 0.8) +
  scale_x_continuous(
    trans = "pseudo_log",
    breaks = c(0, 10, 100, 1000, 10000, 100000, 1000000),
    labels = label_comma()
  ) +
  theme_minimal() +
  labs(
    title = "Rozkład całkowitej liczby potwierdzonych przypadków",
    x = "Liczba potwierdzonych przypadków",
    y = "Liczebność"
  ) +
  theme(
    axis.text.x = element_text(angle = 30, hjust = 1)
  )

Histogram przedstawia rozkład liczby potwierdzonych zakażeń w poszczególnych państwach, wykorzystując skalę logarytmiczną na osi poziomej w celu czytelnego zobrazowania skrajnych dysproporcji w danych. Zdecydowana większość krajów znajduje się w lewej części wykresu, co oznacza, że w analizowanym okresie najczęściej odnotowywano tam jedynie pojedyncze lub nieliczne przypadki infekcji (poniżej 10). Widoczny jest wyraźny „długi ogon” rozkładu, wskazujący na to, że państwa z masową skalą zachorowań (powyżej 10 tysięcy czy 100 tysięcy przypadków) stanowią rzadkie wyjątki w skali globalnej.

ggplot(df_final, aes(x = Total_death)) +
  geom_histogram(bins = 50, fill = "steelblue", color = "white", alpha = 0.8) +
  scale_x_continuous(
    trans = "pseudo_log",
    breaks = c(0, 10, 100, 1000, 10000, 100000, 1000000),
    labels = label_comma()
  ) +
  theme_minimal() +
  labs(
    title = "Rozkład całkowitej liczby zgonów",
    x = "Liczba zgonów",
    y = "Liczebność"
  ) +
  theme(
    axis.text.x = element_text(angle = 30, hjust = 1)
  )

Histogram przedstawia rozkład liczby zgonów w poszczególnych krajach, wykorzystując skalę logarytmiczną do uwzględnienia dużych dysproporcji w danych. Wykres jest zdominowany przez wysoką kolumnę przy wartości zero, co oznacza, że w zdecydowanej większości badanych państw (ponad 100) do tego momentu nie odnotowano żadnej ofiary śmiertelnej. Widoczny po prawej stronie „długi ogon” potwierdza, że kraje z liczbą zgonów przekraczającą 10, 100 czy 1000 stanowiły w tamtym okresie nieliczne, odosobnione przypadki na tle globalnym.

ggplot(df_final, aes(x = Total_recovered)) +
  geom_histogram(bins = 50, fill = "steelblue", color = "white", alpha = 0.8) +
  scale_x_continuous(
    trans = "pseudo_log",
    breaks = c(0, 10, 100, 1000, 10000, 100000, 1000000),
    labels = label_comma()
  ) +
  theme_minimal() +
  labs(
    title = "Rozkład całkowitej liczby wyzdrowień",
    x = "Liczba wyzdrowień",
    y = "Liczebność"
  ) +
  theme(
    axis.text.x = element_text(angle = 30, hjust = 1)
  )

Histogram obrazuje rozkład liczby wyzdrowień w poszczególnych państwach, wykorzystując skalę logarytmiczną do uwydatnienia różnic rzędów wielkości. Wykres jest zdominowany przez najwyższą kolumnę przy wartości zero, co wskazuje, że w zdecydowanej większości analizowanych krajów (ponad 80) w badanym okresie nie odnotowano jeszcze żadnego przypadku wyzdrowienia. Jedynie nieliczne państwa, będące wczesnymi epicentrami pandemii, znajdują się w prawej części wykresu z liczbą ozdrowieńców sięgającą tysięcy lub dziesiątek tysięcy.

ggplot(df_final, aes(x = Total_stillSick)) +
  geom_histogram(bins = 50, fill = "steelblue", color = "white", alpha = 0.8) +
  scale_x_continuous(
    trans = "pseudo_log",
    breaks = c(0, 10, 100, 1000, 10000, 100000, 1000000),
    labels = label_comma()
  ) +
  theme_minimal() +
  labs(
    title = "Rozkład liczby aktywnych przypadków",
    x = "Liczba aktywnych przypadków",
    y = "Liczebność"
  ) +
  theme(
    axis.text.x = element_text(angle = 30, hjust = 1)
  )

Histogram prezentuje rozkład liczby aktywnych przypadków (osób wciąż chorujących) w analizowanych krajach, wykorzystując skalę logarytmiczną do uwzględnienia ogromnych dysproporcji między państwami. Wykres wskazuje, że w większości regionów pandemia znajdowała się na etapie, w którym liczba aktualnie chorych była stosunkowo niska (skupisko słupków po lewej stronie), rzadko przekraczając 100 osób. Długi, prawostronny ogon rozkładu ujawnia jednak istnienie nielicznych, ale intensywnych ognisk wirusa, gdzie liczba aktywnych zakażeń sięga rzędu 10 tysięcy i więcej.

ggplot(df_final, aes(x = Population)) +
  geom_histogram(bins = 50, fill = "steelblue", color = "white", alpha = 0.8) +
  scale_x_continuous(
    trans = "pseudo_log",
    breaks = c(0, 1000, 10000, 100000, 1000000, 10000000, 100000000, 1000000000),
    labels = label_comma()
  ) +
  theme_minimal() +
  labs(
    title = "Rozkład liczby ludności",
    x = "Populacja",
    y = "Liczebność"
  ) +
  theme(
    axis.text.x = element_text(angle = 30, hjust = 1)
  )

Histogram prezentuje strukturę demograficzną analizowanych państw, która w odróżnieniu od silnie skośnych danych epidemicznych na skali logarytmicznej wykazuje cechy zbliżone do rozkładu normalnego. Największa liczba krajów mieści się w środkowym przedziale populacyjnym (od kilku do kilkudziesięciu milionów mieszkańców), co obrazuje koncentracja słupków w centrum wykresu, natomiast krańce osi reprezentują odpowiednio małe terytoria wyspiarskie oraz mocarstwa o populacji przekraczającej miliard obywateli.

ggplot(df_final, aes(x = Density)) +
  geom_histogram(bins = 50, fill = "steelblue", color = "white", alpha = 0.8) +
  scale_x_continuous(
    trans = "pseudo_log",
    breaks = c(0, 10, 100, 1000, 10000, 25000),
    labels = label_comma()
  ) +
  theme_minimal() +
  labs(
    title = "Rozkład gęstości zaludnienia",
    x = "Gęstość zaludnienia (os./km²)",
    y = "Liczebność"
  ) +
  theme(
    axis.text.x = element_text(angle = 30, hjust = 1)
  )

Histogram obrazuje strukturę gęstości zaludnienia w analizowanych państwach, gdzie zastosowanie skali logarytmicznej pozwala na czytelne przedstawienie skrajnych dysproporcji demograficznych. Rozkład danych ma wyraźną dominację krajów o umiarkowanym zagęszczeniu (od kilkudziesięciu do kilkuset osób na km²), co widać w centralnej części wykresu. Jednocześnie wizualizacja uwydatnia istnienie ekstremalnych odstępstw, w tym nielicznych terytoriów o bardzo wysokiej gęstości zaludnienia przekraczającej 10 tysięcy osób na kilometr kwadratowy, widocznych po prawej stronie osi.

ggplot(df_final, aes(x = MedianAge)) +
  geom_histogram(bins = 30, fill = "steelblue", color = "white", alpha = 0.8) +
  scale_x_continuous(
    breaks = seq(15, 55, by = 5)
  ) +
  theme_minimal() +
  labs(
    title = "Rozkład mediany wieku",
    x = "Mediana wieku (lata)",
    y = "Liczebność"
  )

Histogram prezentuje strukturę demograficzną analizowanych państw pod kątem mediany wieku, ujawniając nieregularny, wielomodalny charakter rozkładu, co odzwierciedla głębokie globalne zróżnicowanie na społeczeństwa młode oraz starzejące się. Wyraźnie widoczne są oddzielne skupiska państw o niskiej medianie wieku w okolicach 15–20 lat oraz silna reprezentacja krajów o starszej populacji (szczyt w przedziale 40–45 lat), przy czym zakres danych zamyka wartość maksymalna sięgająca blisko 55 lat.

ggplot(df_final, aes(x = Mortality_Rate)) +
  geom_histogram(bins = 50, fill = "steelblue", color = "white", alpha = 0.8) +
  scale_x_continuous(
    n.breaks = 10
  ) +
  theme_minimal() +
  labs(
    title = "Rozkład wskaźnika śmiertelności wśród zarażonych",
    x = "Śmiertelność",
    y = "Liczebność"
  ) +
  theme(
    axis.text.x = element_text(angle = 30, hjust = 1)
  )

Histogram prezentuje rozkład stopy śmiertelności (CFR) w badanych państwach, ujawniając silną prawostronną asymetrię danych. Wykres zdominowany jest przez wysoką kolumnę w okolicach zera, co oznacza, że w analizowanym okresie większość krajów nie odnotowała ofiar śmiertelnych lub ich odsetek był minimalny. Pozostałe wartości skupiają się głównie w przedziale poniżej 10%, z nielicznymi, ekstremalnymi wyjątkami sięgającymi nawet 100% (widocznymi po prawej stronie osi), co jest charakterystyczne dla początkowej fazy pandemii, gdy statystyki w poszczególnych krajach opierają się na bardzo małej liczbie wykrytych przypadków.

ggplot(df_final, aes(x = Recovery_Rate)) +
  geom_histogram(bins = 50, fill = "steelblue", color = "white", alpha = 0.8) +
  scale_x_continuous(
    n.breaks = 10
  ) +
  theme_minimal() +
  labs(
    title = "Rozkład wskaźnika wyzdrowień wśród zarażonych",
    x = "Wskaźnik wyzdrowień",
    y = "Liczebność"
  ) +
  theme(
    axis.text.x = element_text(angle = 30, hjust = 1)
  )

Histogram obrazuje rozkład wskaźnika wyzdrowień w analizowanych państwach, wykazując ekstremalną asymetrię prawostronną. Wykres jest całkowicie zdominowany przez pierwszą kolumnę przy wartości zero, co świadczy o tym, że w zdecydowanej większości krajów (blisko 100) proces zdrowienia pacjentów jeszcze się statystycznie nie rozpoczął lub nie został zaraportowany. Długi, płaski ogon rozkładu wskazuje na nieliczne państwa, w których odsetek wyzdrowień jest wyższy, osiągając w pojedynczych przypadkach wartości zbliżone do 100% (najpewniej w krajach z pojedynczymi, wyleczonymi przypadkami).

ggplot(df_final, aes(x = Incidence_Rate)) +
  geom_histogram(bins = 50, fill = "steelblue", color = "white", alpha = 0.8) +
  scale_x_continuous(
    n.breaks = 10
  ) +
  theme_minimal() +
  labs(
    title = "Rozkład zachorowalności na mieszkańca",
    x = "Wskaźnik zachorowalnośći na osobę",
    y = "Liczebność"
  ) +
  theme(
    axis.text.x = element_text(angle = 30, hjust = 1)
  )

Histogram przedstawia rozkład wskaźnika zachorowalności w przeliczeniu na jednego mieszkańca, obrazując skrajną nierównomierność rozprzestrzeniania się wirusa w badanej populacji państw. Wykres zdominowany jest przez masywne skupienie wartości w okolicach zera, co dowodzi, że w analizowanym oknie czasowym odsetek osób zakażonych względem ogółu ludności był w większości regionów świata wciąż marginalny. Widoczny po prawej stronie, odizolowany punkt (outlier) wskazuje na istnienie pojedynczego ogniska o wyjątkowo wysokiej intensywności transmisji, gdzie wirus zdołał zainfekować nieporównywalnie większą część społeczeństwa niż w pozostałych krajach.

ggplot(df_final, aes(x = Mortality_per_capita)) +
  geom_histogram(bins = 50, fill = "steelblue", color = "white", alpha = 0.8) +
  scale_x_continuous(
    trans = "pseudo_log",
    breaks = c(0, 0.00005, 0.0001, 0.00015, 0.0002, 0.0005),
    labels = label_number(accuracy = 0.00001)
  ) +
  theme_minimal() +
  labs(
    title = "Rozkład śmiertelności na mieszkańca",
    x = "Liczba zgonów na osobę",
    y = "Liczebność"
  ) +
  theme(
    axis.text.x = element_text(angle = 30, hjust = 1)
  )

Histogram obrazuje rozkład wskaźnika umieralności w przeliczeniu na jednego mieszkańca, ujawniając, że w analizowanym okresie globalne obciążenie demograficzne skutkami pandemii było statystycznie marginalne dla niemal wszystkich państw. Wykres jest całkowicie zdominowany przez słupek przy wartościach bliskich zeru, co oznacza, że w zdecydowanej większości krajów liczba zgonów w stosunku do populacji była znikoma. Jedynie pojedynczy, skrajny punkt widoczny po prawej stronie wskazuje na istnienie odosobnionego regionu, gdzie wskaźnik ten osiągnął zauważalnie wyższy poziom na tle reszty świata.

ggplot(df_final, aes(x = StillSick_per_capita)) +
  geom_histogram(bins = 50, fill = "steelblue", color = "white", alpha = 0.8) +
  scale_x_continuous(
    trans = "pseudo_log",
    breaks = c(0, 0.0005, 0.0010, 0.0015, 0.0020, 0.0025),
    labels = label_number(accuracy = 0.0001)
  ) +
  theme_minimal() +
  labs(
    title = "Rozkład aktywnych przypadków na mieszkańca",
    x = "Aktywne przypadki na osobę",
    y = "Liczebność"
  ) +
  theme(
    axis.text.x = element_text(angle = 30, hjust = 1)
  )

Histogram przedstawia rozkład liczby aktywnych przypadków w przeliczeniu na jednego mieszkańca, co pozwala ocenić rzeczywiste obciążenie społeczeństw trwającą infekcją. Wykres jest niemal całkowicie zdominowany przez wysoki słupek przy wartościach bliskich zeru, co wskazuje, że w skali globalnej odsetek osób aktualnie chorujących był w analizowanym momencie znikomy dla zdecydowanej większości państw. Jedynie pojedynczy, wyraźnie odseparowany słupek po prawej stronie osi reprezentuje nieliczny wyjątek (kraj o najwyższej intensywności epidemii), gdzie wirus zdołał zainfekować zauważalnie większą część populacji niż w pozostałych regionach świata.

cols_abs <- c("Total_confirmed", "Total_death", "Total_recovered", "Total_stillSick")

nazwy_pl <- c(
  "Total_confirmed" = "Potwierdzone",
  "Total_death" = "Zgony",
  "Total_recovered" = "Wyzdrowienia",
  "Total_stillSick" = "Aktywne przypadki"
)

df_abs <- df_final %>%
  select(Country.Region, all_of(cols_abs)) %>%
  pivot_longer(cols = all_of(cols_abs), names_to = "Zmienna", values_to = "Wartosc") %>%
  filter(Wartosc > 0)

ggplot(df_abs, aes(x = Zmienna, y = Wartosc, fill = Zmienna)) +
  geom_jitter(width = 0.2, alpha = 0.3, color = "gray30") +
  geom_boxplot(alpha = 0.7, outlier.colour = "red", outlier.shape = 1) +
  facet_wrap(~ Zmienna, scales = "free", labeller = as_labeller(nazwy_pl)) +
  scale_y_log10(labels = label_comma()) +
  labs(
    title = "Rozkład zmiennych",
    subtitle = "Skala logarytmiczna, niezależne osie Y dla każdego panelu",
    y = "Liczba przypadków (skala log)",
    x = NULL
  ) +
  theme_minimal() +
  theme(
    legend.position = "none",
    axis.text.x = element_blank()
  )

Wykres pudełkowy z nałożonymi punktami rzeczywistymi obrazuje rozkład czterech kluczowych zmiennych bezwzględnych w skali logarytmicznej, co umożliwia porównanie danych o skrajnie różnej rozpiętości. Dla wszystkich kategorii, od potwierdzonych zakażeń po zgony, charakterystyczne jest niskie położenie mediany (pozioma kreska wewnątrz pudełka), co potwierdza, że typowy kraj odnotował relatywnie niewielką liczbę przypadków, podczas gdy czerwone punkty na szczycie wykresów wskazują na ekstremalne wartości odstające, reprezentujące państwa najsilniej dotknięte pandemią.

cols_rate <- c("Incidence_Rate", "Mortality_per_capita", 
               "StillSick_per_capita", "Density")

nazwy_pl_rate <- c(
  "Incidence_Rate" = "Wskaźnik zachorowalności",
  "Mortality_per_capita" = "Zgony na mieszkańca",
  "StillSick_per_capita" = "Aktywne przypadki na os.",
  "Density" = "Gęstość zaludnienia"
)

df_rate <- df_final %>%
  select(Country.Region, all_of(cols_rate)) %>%
  pivot_longer(cols = all_of(cols_rate), names_to = "Zmienna", values_to = "Wartosc") %>%
  filter(Wartosc > 0)

ggplot(df_rate, aes(x = Zmienna, y = Wartosc, fill = Zmienna)) +
  geom_jitter(width = 0.2, alpha = 0.3, color = "gray30") +
  geom_boxplot(alpha = 0.7, outlier.colour = "red") +
  facet_wrap(~Zmienna, scales = "free", labeller = as_labeller(nazwy_pl_rate)) + 
  scale_y_log10(labels = label_comma()) +
  labs(
    title = "Wskaźniki epidemiologiczne i gęstość zaludnienia",
    subtitle = "Skala logarytmiczna, niezależne osie Y",
    y = "Wartość (skala log)",
    x = NULL
  ) +
  theme_minimal() +
  theme(
    legend.position = "none", 
    axis.text.x = element_blank()
  )

Wykres pudełkowy z nałożonymi punktami prezentuje rozkład gęstości zaludnienia oraz kluczowych wskaźników epidemiologicznych w ujęciu relatywnym (na mieszkańca), wykorzystując niezależne skale logarytmiczne dla każdej zmiennej w celu czytelnego porównania rzędów wielkości. Analiza ujawnia, że mimo ogromnego zróżnicowania gęstości zaludnienia (od kilku do kilkunastu tysięcy osób na km²), wskaźniki zachorowalności i umieralności w większości krajów pozostają na bardzo niskim, ułamkowym poziomie, co obrazuje wczesną fazę rozwoju pandemii w skali globalnej. Czerwone punkty odstające (outliers) widoczne nad górnymi wąsami wykresów identyfikują nieliczne państwa, w których intensywność ataku wirusa lub zagęszczenie ludności drastycznie odbiegają od światowej normy.

cols_pct <- c("Mortality_Rate", "Recovery_Rate", "MedianAge")

df_pct <- df_final %>%
  select(Country.Region, all_of(cols_pct)) %>%
  pivot_longer(cols = all_of(cols_pct), names_to = "Zmienna", values_to = "Wartosc") %>%
  mutate(Zmienna = case_match(
    Zmienna,
    "Mortality_Rate" ~ "Śmiertelność",
    "Recovery_Rate" ~ "Wskaźnik wyzdrowień",
    "MedianAge" ~ "Mediana wieku"
  ))

ggplot(df_pct, aes(x = Zmienna, y = Wartosc, fill = Zmienna)) +
  geom_violin(trim = TRUE, scale = "width", alpha = 0.5) +
  geom_boxplot(width = 0.1, outlier.colour = "red", fill = "white", alpha = 0.8) +
  facet_wrap(~Zmienna, scales = "free") +
  scale_y_continuous(trans = "pseudo_log", labels = label_number()) +
  labs(
    title = "Demografia i wskaźniki epidemiologiczne",
    subtitle = "Wartości surowe (skala pseudo-logarytmiczna)",
    y = "Wartość",
    x = NULL
  ) +
  theme_minimal() +
  theme(
    legend.position = "none",
    axis.text.x = element_blank()
  )

Zestawienie wykresów skrzypcowych z naniesionymi wykresami pudełkowymi jaskrawo kontrastuje stabilną strukturę demograficzną z dynamiczną naturą wskaźników epidemicznych. Panel dotyczący mediany wieku ukazuje szeroki, rozbudowany rozkład danych, co świadczy o dużym zróżnicowaniu globalnym bez dominacji jednej wartości, podczas gdy wskaźniki śmiertelności i wyzdrowień przybierają kształt silnie spłaszczony przy osi dolnej z długimi, wąskimi wypustkami ku górze. Taka wizualizacja potwierdza, że o ile struktura wiekowa jest cechą stałą i różnorodną, to wysokie odsetki zgonów lub wyzdrowień stanowiły w analizowanym momencie statystyczne anomalie (oznaczone czerwonymi punktami), podczas gdy normą dla większości świata były wartości bliskie zeru.

print("--- TOP 10: Najwięcej potwierdzonych przypadków (Total Confirmed) ---")
## [1] "--- TOP 10: Najwięcej potwierdzonych przypadków (Total Confirmed) ---"
df_final %>%
  select(Country.Region, Total_confirmed, Population) %>%
  arrange(desc(Total_confirmed)) %>%
  head(10) %>%
  print()
## # A tibble: 10 × 3
##    Country.Region Total_confirmed  Population
##    <chr>                    <int>       <dbl>
##  1 China                    81033 1423520358.
##  2 Italy                    27980   60130136 
##  3 Iran                     14991   87051648.
##  4 Spain                     9942   47435119 
##  5 Korea, South              8236   51767846 
##  6 Germany                   7272   83559186.
##  7 France                    6650   65729459 
##  8 US                        4632  337790066.
##  9 Switzerland               2200    8577524 
## 10 United Kingdom            1551   67110958
print("--- TOP 10: Najwięcej zgonów (Total Death) ---")
## [1] "--- TOP 10: Najwięcej zgonów (Total Death) ---"
df_final %>%
  select(Country.Region, Total_death, Total_confirmed) %>%
  arrange(desc(Total_death)) %>%
  head(10) %>%
  print()
## # A tibble: 10 × 3
##    Country.Region Total_death Total_confirmed
##    <chr>                <int>           <int>
##  1 China                 3217           81033
##  2 Italy                 2158           27980
##  3 Iran                   853           14991
##  4 Spain                  342            9942
##  5 France                 148            6650
##  6 US                      85            4632
##  7 Korea, South            75            8236
##  8 United Kingdom          56            1551
##  9 Japan                   27             825
## 10 Netherlands             24            1414
print("--- TOP 10: Najwięcej wyzdrowień (Total Recovered) ---")
## [1] "--- TOP 10: Najwięcej wyzdrowień (Total Recovered) ---"
df_final %>%
  select(Country.Region, Total_recovered, Total_confirmed) %>%
  arrange(desc(Total_recovered)) %>%
  head(10) %>%
  print()
## # A tibble: 10 × 3
##    Country.Region Total_recovered Total_confirmed
##    <chr>                    <int>           <int>
##  1 China                    67910           81033
##  2 Iran                      4590           14991
##  3 Italy                     2749           27980
##  4 Korea, South              1137            8236
##  5 Spain                      530            9942
##  6 Japan                      144             825
##  7 Singapore                  109             243
##  8 Bahrain                     77             214
##  9 Germany                     67            7272
## 10 Malaysia                    42             566
print("--- TOP 10: Najwięcej aktywnych przypadków (Total Still Sick) ---")
## [1] "--- TOP 10: Najwięcej aktywnych przypadków (Total Still Sick) ---"
df_final %>%
  select(Country.Region, Total_stillSick, Total_confirmed) %>%
  arrange(desc(Total_stillSick)) %>%
  head(10) %>%
  print()
## # A tibble: 10 × 3
##    Country.Region Total_stillSick Total_confirmed
##    <chr>                    <int>           <int>
##  1 Italy                    23073           27980
##  2 China                     9906           81033
##  3 Iran                      9548           14991
##  4 Spain                     9070            9942
##  5 Germany                   7188            7272
##  6 Korea, South              7024            8236
##  7 France                    6490            6650
##  8 US                        4530            4632
##  9 Switzerland               2182            2200
## 10 United Kingdom            1474            1551
print("--- TOP 10: Gęstość Zaludnienia (Density) ---")
## [1] "--- TOP 10: Gęstość Zaludnienia (Density) ---"
df_final %>%
  select(Country.Region, Density, Population) %>%
  arrange(desc(Density)) %>%
  head(10) %>%
  print()
## # A tibble: 10 × 3
##    Country.Region                 Density Population
##    <chr>                            <dbl>      <dbl>
##  1 Monaco                          25577.     38109 
##  2 Singapore                        8301.   5669562.
##  3 Bahrain                          1897.   1485670.
##  4 Maldives                         1626.    487731 
##  5 Malta                            1600.    504016.
##  6 Bangladesh                       1267. 164913055 
##  7 Guernsey                          981.     62784.
##  8 Jersey                            887.    102856.
##  9 occupied Palestinian territory    824.   4957768 
## 10 Mayotte                           733.    274910.
print("--- TOP 10: Zachorowalność na populację (Incidence Rate) ---")
## [1] "--- TOP 10: Zachorowalność na populację (Incidence Rate) ---"
df_final %>%
  select(Country.Region, Incidence_Rate, Total_confirmed, Population) %>%
  arrange(desc(Incidence_Rate)) %>%
  head(10) %>%
  print()
## # A tibble: 10 × 4
##    Country.Region Incidence_Rate Total_confirmed Population
##    <chr>                   <dbl>           <int>      <dbl>
##  1 San Marino           0.00315              109     34653 
##  2 Iceland              0.000499             180    360700.
##  3 Italy                0.000465           27980  60130136 
##  4 Switzerland          0.000256            2200   8577524 
##  5 Norway               0.000249            1333   5347730.
##  6 Spain                0.000210            9942  47435119 
##  7 Monaco               0.000184               7     38109 
##  8 Iran                 0.000172           14991  87051648.
##  9 Denmark              0.000160             932   5814618.
## 10 Korea, South         0.000159            8236  51767846
print("--- TOP 10: Zgony na populację (Mortality per Capita) ---")
## [1] "--- TOP 10: Zgony na populację (Mortality per Capita) ---"
df_final %>%
  select(Country.Region, Mortality_per_capita, Total_death, Population) %>%
  arrange(desc(Mortality_per_capita)) %>%
  head(10) %>%
  print()
## # A tibble: 10 × 4
##    Country.Region Mortality_per_capita Total_death  Population
##    <chr>                         <dbl>       <int>       <dbl>
##  1 San Marino               0.000202             7      34653 
##  2 Italy                    0.0000359         2158   60130136 
##  3 Iran                     0.00000980         853   87051648.
##  4 Spain                    0.00000721         342   47435119 
##  5 Martinique               0.00000278           1     359612.
##  6 China                    0.00000226        3217 1423520358.
##  7 France                   0.00000225         148   65729459 
##  8 Switzerland              0.00000163          14    8577524 
##  9 Luxembourg               0.00000161           1     620163 
## 10 Korea, South             0.00000145          75   51767846
print("--- TOP 10: Aktywne przypadki na populację (Still Sick per Capita) ---")
## [1] "--- TOP 10: Aktywne przypadki na populację (Still Sick per Capita) ---"
df_final %>%
  select(Country.Region, StillSick_per_capita, Total_stillSick, Population) %>%
  arrange(desc(StillSick_per_capita)) %>%
  head(10) %>%
  print()
## # A tibble: 10 × 4
##    Country.Region StillSick_per_capita Total_stillSick Population
##    <chr>                         <dbl>           <int>      <dbl>
##  1 San Marino                 0.00283               98     34653 
##  2 Iceland                    0.000499             180    360700.
##  3 Italy                      0.000384           23073  60130136 
##  4 Switzerland                0.000254            2182   8577524 
##  5 Norway                     0.000249            1329   5347730.
##  6 Spain                      0.000191            9070  47435119 
##  7 Monaco                     0.000184               7     38109 
##  8 Denmark                    0.000160             928   5814618.
##  9 Qatar                      0.000155             435   2797921 
## 10 Estonia                    0.000154             204   1326822.
print("--- TOP 10: Śmiertelność przypadków CFR (Mortality Rate) ---")
## [1] "--- TOP 10: Śmiertelność przypadków CFR (Mortality Rate) ---"
df_final %>%
  select(Country.Region, Mortality_Rate, Total_death, Total_confirmed) %>%
  arrange(desc(Mortality_Rate)) %>%
  head(10) %>%
  print()
## # A tibble: 10 × 4
##    Country.Region Mortality_Rate Total_death Total_confirmed
##    <chr>                   <dbl>       <int>           <int>
##  1 Sudan                  1                1               1
##  2 Guatemala              0.5              1               2
##  3 Guyana                 0.25             1               4
##  4 Ukraine                0.143            1               7
##  5 Philippines            0.0845          12             142
##  6 Iraq                   0.0806          10             124
##  7 Italy                  0.0771        2158           27980
##  8 Algeria                0.0741           4              54
##  9 Azerbaijan             0.0667           1              15
## 10 Martinique             0.0667           1              15
print("--- TOP 10: Wskaźnik wyzdrowień (Recovery Rate) ---")
## [1] "--- TOP 10: Wskaźnik wyzdrowień (Recovery Rate) ---"
df_final %>%
  select(Country.Region, Recovery_Rate, Total_recovered, Total_confirmed) %>%
  arrange(desc(Recovery_Rate)) %>%
  head(10) %>%
  print()
## # A tibble: 10 × 4
##    Country.Region Recovery_Rate Total_recovered Total_confirmed
##    <chr>                  <dbl>           <int>           <int>
##  1 Nepal                  1                   1               1
##  2 China                  0.838           67910           81033
##  3 Andorra                0.5                 1               2
##  4 Singapore              0.449             109             243
##  5 Oman                   0.409               9              22
##  6 Azerbaijan             0.4                 6              15
##  7 Bahrain                0.360              77             214
##  8 Iran                   0.306            4590           14991
##  9 Taiwan*                0.299              20              67
## 10 Vietnam                0.262              16              61
print("--- TOP 10: Największa populacja (Population) ---")
## [1] "--- TOP 10: Największa populacja (Population) ---"
df_final %>%
  select(Country.Region, Population, Density) %>%
  arrange(desc(Population)) %>%
  head(10) %>%
  print()
## # A tibble: 10 × 3
##    Country.Region  Population Density
##    <chr>                <dbl>   <dbl>
##  1 China          1423520358.  148.  
##  2 India          1389030312   467.  
##  3 US              337790066.   36.9 
##  4 Indonesia       272489381   143.  
##  5 Pakistan        230800898.  299.  
##  6 Nigeria         209485641   230.  
##  7 Brazil          207455460.   24.8 
##  8 Bangladesh      164913055  1267.  
##  9 Russia          146533067     8.95
## 10 Japan           126699424.  336.
print("--- TOP 10: Najwyższa mediana wieku (Median Age) ---")
## [1] "--- TOP 10: Najwyższa mediana wieku (Median Age) ---"
df_final %>%
  select(Country.Region, MedianAge, Population) %>%
  arrange(desc(MedianAge)) %>%
  head(10) %>%
  print()
## # A tibble: 10 × 3
##    Country.Region MedianAge Population
##    <chr>              <dbl>      <dbl>
##  1 Monaco              54.6     38109 
##  2 Japan               47.3 126699424.
##  3 Martinique          47.0    359612.
##  4 Italy               46.0  60130136 
##  5 San Marino          45.3     34653 
##  6 Germany             44.9  83559186.
##  7 Portugal            44.6  10343213 
##  8 Greece              44.0  10718576.
##  9 Croatia             44.0   3986334.
## 10 Guadeloupe          43.8    410256.

Analiza zgromadzonych rankingów wskazuje na dominującą rolę Chin i Włoch w początkowej fazie pandemii, przy czym Chiny odnotowały najwyższe wartości bezwzględne w kategoriach potwierdzonych zakażeń, zgonów oraz wyzdrowień. Włochy wyróżniały się największą na świecie liczbą aktywnych przypadków oraz bardzo wysoką śmiertelnością przypadków (CFR) na poziomie 7,7%, ustępując w tym rankingu jedynie państwom o śladowej liczbie wykrytych infekcji, takim jak Sudan czy Gwatemala. W ujęciu relatywnym najbardziej dotkniętym terytorium okazało się San Marino, które zajęło pierwsze miejsce pod względem zachorowalności, umieralności oraz liczby aktywnych chorych w przeliczeniu na jednego mieszkańca. Wysokie wskaźniki zapadalności odnotowano również w Islandii i Szwajcarii, co kontrastuje z bardzo niskimi wartościami tych miar w większości pozostałych regionów świata. Pod względem demograficznym kraje najsilniej dotknięte wirusem, jak Włochy czy Niemcy, charakteryzują się wysoką medianą wieku przekraczającą 44 lata, podczas gdy Monako łączy najwyższą średnią wieku (blisko 55 lat) z ekstremalnie wysoką gęstością zaludnienia. Statystyki wyzdrowień poza Chinami najkorzystniej prezentowały się w Iranie i Singapurze, choć globalny wskaźnik ozdrowień pozostawał na niskim poziomie ze względu na wczesny etap rozwoju zjawiska.

vars_for_cluster <- df_final %>%
  select(
    Incidence_Rate,
    Mortality_per_capita,
    StillSick_per_capita,
    Mortality_Rate,
    Recovery_Rate,
    Total_confirmed,
    Total_death,
    Total_recovered,
    Total_stillSick,
    Population,
    Density,
    MedianAge,
    Active_Rate
  )

cor_matrix <- cor(vars_for_cluster, method = "pearson", use = "complete.obs")

colnames(cor_matrix) <- c(
  "Zachorowalność",       # Incidence
  "Zgony na os.",      # Mortality per capita
  "Aktywne na os.",    # Active per capita
  "Śmiertelność(COVID)",      # Mortality Rate (Rate/CFR)
  "Wsk. wyzdr.",       # Recovery Rate
  "Suma potw.",        # Total Confirmed
  "Suma zgonów",       # Total Deaths
  "Suma wyzdr.",       # Total Recovered
  "Suma akt.",         # Total Active
  "Populacja",         # Population
  "Gęstość",           # Density
  "Mediana wieku",     # Median Age
  "Wsk. aktywności"    # Actve Rate
)
rownames(cor_matrix) <- colnames(cor_matrix)

my_palette <- colorRampPalette(c("#D73027", "#F46D43", "#FDAE61", "#FEE090", "#E0F3F8", "#74ADD1", "#4575B4"))(200)

corrplot(cor_matrix,
         method = "color",
         col = my_palette,
         addCoef.col = "black",
         tl.col = "black",
         tl.srt = 45,
         number.cex = 0.55,
         tl.cex = 0.7,
         number.digits = 2,
         addgrid.col = "grey80",
         mar = c(0, 0, 2, 0),
         title = "Macierz współczynników korelacji Pearsona"
)

Macierz korelacji Pearsona ujawnia trzy główne skupiska silnie powiązanych ze sobą zmiennych. Pierwsze z nich to wskaźniki relatywne, gdzie zachorowalność, liczba zgonów na mieszkańca oraz aktywne przypadki na osobę są ze sobą niemal idealnie skorelowane pozytywnie (współczynniki 0,97–1,00). Druga grupa obejmuje sumaryczne dane bezwzględne, wykazujące bardzo silne korelacje dodatnie (0,76–0,96) między całkowitą liczbą potwierdzonych przypadków, zgonów oraz wyzdrowień. Istotnym faktem jest również wyraźny związek między wielkością populacji a sumarycznymi statystykami epidemiologicznymi, szczególnie w kontekście liczby wyzdrowień (0,68) i potwierdzonych zakażeń (0,64). Zmienne demograficzne, takie jak gęstość zaludnienia czy mediana wieku, wykazują bardzo słabe lub bliskie zeru korelacje z przebiegiem pandemii, co sugeruje, że na tym etapie czynniki te nie miały decydującego wpływu na ogólną dynamikę zakażeń.

cor_matrix <- cor(vars_for_cluster, method = "spearman", use = "complete.obs")

colnames(cor_matrix) <- c(
  "Zapadalność",       # Incidence
  "Zgony na os.",      # Mortality per capita
  "Aktywne na os.",    # Active per capita
  "Śmiertelność(COVID)",# Mortality Rate (Rate/CFR)
  "Wsk. wyzdr.",       # Recovery Rate
  "Suma potw.",        # Total Confirmed
  "Suma zgonów",       # Total Deaths
  "Suma wyzdr.",       # Total Recovered
  "Suma akt.",         # Total Active
  "Populacja",         # Population
  "Gęstość",           # Density
  "Mediana wieku",     # Median Age
  "Wsk. aktywności"    # Actve Rate
)
rownames(cor_matrix) <- colnames(cor_matrix)

my_palette <- colorRampPalette(c("#D73027", "#F46D43", "#FDAE61", "#FEE090", "#E0F3F8", "#74ADD1", "#4575B4"))(200)

corrplot(cor_matrix,
         method = "color",        
         col = my_palette,          
         addCoef.col = "black",
         tl.col = "black",        
         tl.srt = 45,             
         number.cex = 0.55,
         tl.cex = 0.7,
         number.digits = 2,
         addgrid.col = "grey80",
         mar = c(0, 0, 2, 0),
         title = "Macierz współczynników korelacji Spearmana"
)

Macierz korelacji Spearmana ujawnia szereg istotnych współzależności, wśród których najsilniejsze dodatnie związki występują pomiędzy parami wskaźników relatywnych a ich odpowiednikami bezwzględnymi. Niemal pełną zbieżność wykazują zapadalność i liczba aktywnych przypadków na mieszkańca (0,99), a także wskaźnik zgonów na mieszkańca z ogólną sumą zgonów (0,98) oraz śmiertelnością (0,95), co potwierdza wysoką spójność raportowanych danych. Kluczową informacją demograficzną jest wyraźna zależność między medianą wieku a intensywnością pandemii, gdzie starsze społeczeństwa korelują z wyższą zapadalnością i liczbą aktywnych przypadków na osobę (0,73). Ponadto, suma potwierdzonych przypadków jest nierozerwalnie związana z sumą aktywnych zakażeń (1,00), a wskaźnik wyzdrowień wykazuje silną korelację z całkowitą liczbą ozdrowieńców (0,93). Z kolei wielkość populacji wpływa umiarkowanie ujemnie na zapadalność (-0,41) i liczbę aktywnych chorych na osobę (-0,43), co sugeruje, że mniejsze kraje odnotowywały relatywnie wyższy odsetek zakażeń w stosunku do liczby mieszkańców w badanym okresie.

Wnioski z EDA

Przeprowadzona analiza pozwoliła na zidentyfikowanie kluczowych mechanizmów rządzących danymi epidemicznymi w początkowej fazie pandemii oraz wyłonienie zmiennych o największym potencjale informacyjnym dla procesu grupowania. Najważniejsze obserwacje wskazują na skrajną asymetrię rozkładów – podczas gdy większość świata odnotowywała pojedyncze przypadki, nieliczne kraje, takie jak Chiny czy Włochy, stały się potężnymi centrami infekcji. Analiza korelacji Spearmana udowodniła, że czynniki demograficzne, a w szczególności mediana wieku, miały istotny związek z tempem rozprzestrzeniania się wirusa w tamtym okresie.

Do hierarchicznej analizy skupień wytypowano następujące zmienne, które najlepiej różnicują kraje pod względem charakteru przebiegu pandemii i profilu demograficznego:

Zastosowanie tych wskaźników relatywnych zamiast surowych liczb bezwzględnych zapobiegnie dominacji grup przez największe mocarstwa (jak Chiny czy Indie) i umożliwi wykrycie podobieństw w charakterystyce epidemicznej krajów o różnej wielkości.

5. Przygotowanie zmiennych do modelu (transformacje)

Zbiór danych ograniczono do krajów, w których odnotowano co najmniej 10 potwierdzonych przypadków zakażenia. Krok ten podyktowany jest koniecznością eliminacji szumu statystycznego wynikającego z tzw. prawa małych liczb.

Przy skrajnie małej próbie wskaźniki relatywne stają się niestabilne i mogą prowadzić do błędnych wniosków na temat charakterystyki epidemii. Przykładowo, w kraju z zaledwie 1 potwierdzonym przypadkiem, który zakończył się zgonem, wskaźnik śmiertelności (CFR) wyniósłby matematycznie 100% (1/1). Taka wartość stanowiłaby sztuczną anomalię (outlier), która zaburzyłaby wyniki analizy skupień, sugerując ekstremalnie wysoką zjadliwość wirusa, podczas gdy w rzeczywistości wynik ten jest efektem braku reprezentatywnej próby. Dlatego zdecydowano o usunięciu krajów mających mniej niż 10 przypadków w kraju.

df_final = df_final[df_final$Total_confirmed>=10,]

Na podstawie wniosków z eksploracyjnej analizy danych (EDA) oraz macierzy korelacji, do budowy modelu wybrano cztery kluczowe zmienne: Incidence_Rate, Mortality_Rate, Recovery_Rate oraz Density.

Ze względu na specyfikę danych – występowanie silnej asymetrii prawostronnej (“długie ogony”), dużą liczbę zer oraz obecność ekstremalnych wartości odstających – standardowe metody skalowania (jak standaryzacja Z-score czy proste skalowanie Min-Max) mogłyby nie przynieść zadowalających rezultatów. Wartości odstające spłaszczyłyby większość obserwacji do wąskiego przedziału, zacierając różnice między krajami.

W związku z tym zastosowano podejście hybrydowe:

  1. Dla wskaźników epidemicznych (Rates): Zastosowano transformację opartą na Dystrybuancie Empirycznej (ECDF). Metoda ta zastępuje wartość bezwzględną jej rangą (percentylem) w rozkładzie wartości niezerowych. Dzięki temu zmienne zostają zmapowane do przedziału [0, 1], co pozwala na “rozciągnięcie” gęstych skupisk danych i ograniczenie wpływu wartości odstających, przy jednoczesnym zachowaniu porządku rangowego. Wartości zerowe pozostawiono bez zmian.
  2. Dla gęstości zaludnienia (Density): Zastosowano transformację logarytmiczną (log1p), aby zniwelować różnice rzędów wielkości, a następnie przeskalowano wynik do przedziału [0, 1] metodą Min-Max.

Poniższy kod realizuje te przekształcenia oraz wizualizuje uzyskane rozkłady, które powinny być teraz bardziej zbliżone do rozkładu jednostajnego, co ułatwi algorytmom grupowania (opartym na odległościach) poprawne wyodrębnienie struktur.

selected_cols <- c("Incidence_Rate", "Mortality_Rate", "Recovery_Rate", "Density")
df_subset <- df_final[, selected_cols]

transform_rates_ecdf <- function(x) {
  x_new <- x
  pos_indices <- x > 0
  
  if (sum(pos_indices) > 0) {
    pos_values <- x[pos_indices]
    vals_ranked <- ecdf(pos_values)(pos_values) 
    x_new[pos_indices] <- vals_ranked
  }
  return(x_new)
}

transform_density_log <- function(x) {
  x_log <- log1p(x)
  (x_log - min(x_log)) / (max(x_log) - min(x_log))
}

df_transformed <- df_subset %>%
  mutate(
    across(c("Incidence_Rate", "Mortality_Rate", "Recovery_Rate"), transform_rates_ecdf),
    across(c("Density"), transform_density_log)
  )

df_long <- df_transformed %>%
  pivot_longer(cols = everything(), names_to = "Zmienna", values_to = "Wartosc")

ggplot(df_long, aes(x = Wartosc)) +
  geom_histogram(fill = "seagreen", color = "white", bins = 40) +
  facet_wrap(~ Zmienna, scales = "free_y") +
  theme_minimal() +
  labs(title = "Podejście Hybrydowe",
       subtitle = "Density: Logarytm | Rates: Ranking ECDF",
       x = "Wartość znormalizowana [0-1]", 
       y = "Liczebność")

ggplot(df_long, aes(x = Zmienna, y = Wartosc, fill = Zmienna)) +
  geom_boxplot(alpha = 0.7, outlier.size = 1) +
  theme_minimal() +
  labs(title = "Weryfikacja ciągłości danych",
       y = "Wartość znormalizowana") +
  theme(legend.position = "none", axis.text.x = element_text(angle = 45, hjust = 1))

Analiza wygenerowanych wykresów potwierdza skuteczność zastosowanego podejścia hybrydowego w przygotowaniu danych do analizy skupień. Transformacja logarytmiczna zmiennej gęstości zaludnienia skutecznie zniwelowała jej silną prawostronną skośność, nadając rozkładowi kształt zbliżony do normalnego, co jest optymalne dla algorytmów opartych na metryce euklidesowej. Zastosowanie transformacji opartej na dystrybuancie empirycznej (ECDF) dla wskaźników epidemicznych pozwoliło na ich równomierne rozłożenie w znormalizowanym przedziale [0, 1]. Dzięki temu zabiegowi zmaksymalizowano separację między krajami o różnym nasileniu pandemii, jednocześnie zachowując istotną informację o dużej grupie państw, w których nie odnotowano jeszcze zgonów lub wyzdrowień (wartości zerowe). Sprowadzenie wszystkich zmiennych do wspólnej skali zapobiega dominacji cech o wysokiej wariancji nad pozostałymi i pozwala na przejście do właściwego etapu grupowania danych.

6. Tworzenie modelu hierarchicznego

W celu wyznaczenia optymalnych parametrów analizy skupień opracowano skrypt realizujący algorytm pełnego przeszukiwania siatki (ang. Grid Search). Narzędzie to automatycznie testuje i porównuje efektywność modeli hierarchicznych, uwzględniając:

dist_methods <- c("euclidean", "maximum", "manhattan", "canberra")
link_methods <- c("ward.D", "ward.D2", "single", "complete", "average", "mcquitty", "median", "centroid")
k_range <- 2:20

results_list <- list()
counter <- 1

calc_ch_index <- function(data, clusters) {
  n <- nrow(data)
  k <- length(unique(clusters))
  if (k < 2 || k == n) return(NA)
  
  center_global <- colMeans(data)
  tss <- sum(rowSums((sweep(data, 2, center_global))^2))
  
  wss <- 0
  for (i in unique(clusters)) {
    cluster_data <- data[clusters == i, , drop = FALSE]
    if (nrow(cluster_data) > 0) {
      center_cluster <- colMeans(cluster_data)
      wss <- wss + sum(rowSums((sweep(cluster_data, 2, center_cluster))^2))
    }
  }
  
  bss <- tss - wss
  ch <- (bss / (k - 1)) / (wss / (n - k))
  return(ch)
}

calc_db_index <- function(data, clusters) {
  u_clust <- unique(clusters)
  k <- length(u_clust)
  if (k < 2) return(NA)
  
  centers <- matrix(NA, nrow=k, ncol=ncol(data))
  S <- numeric(k)
  
  for(i in 1:k) {
    c_data <- data[clusters == u_clust[i], , drop=FALSE]
    if(nrow(c_data) > 0) {
      centers[i,] <- colMeans(c_data)
      dists <- sqrt(rowSums(sweep(c_data, 2, centers[i,])^2))
      S[i] <- mean(dists)
    } else {
      S[i] <- 0
    }
  }
  
  M <- as.matrix(dist(centers))
  diag(M) <- Inf 
  
  R <- numeric(k)
  for(i in 1:k) {
    if(all(is.infinite(M[i,]))) { 
      R[i] <- 0 
    } else {
      R[i] <- max((S[i] + S) / M[i,], na.rm=TRUE)
    }
  }
  
  return(mean(R[is.finite(R)]))
}

for (d_meth in dist_methods) {
  dist_matrix <- tryCatch({
    dist(df_transformed, method = d_meth)
  }, error = function(e) return(NULL))
  
  if (is.null(dist_matrix)) next
  
  for (l_meth in link_methods) {
    hc_model <- tryCatch({
      hclust(dist_matrix, method = l_meth)
    }, error = function(e) return(NULL))
    
    if (is.null(hc_model)) next
    
    for (k in k_range) {
      groups <- cutree(hc_model, k = k)
      
      sil_obj <- tryCatch({
        silhouette(groups, dist_matrix)
      }, error = function(e) return(NULL))
      
      avg_sil <- if (!is.null(sil_obj) && !all(is.na(sil_obj))) {
        mean(sil_obj[, 3]) 
      } else { 
        NA 
      }
      
      ch_val <- calc_ch_index(as.data.frame(df_transformed), groups)
      
      db_val <- calc_db_index(as.data.frame(df_transformed), groups)
      
      results_list[[counter]] <- data.frame(
        Dist_Method = d_meth,
        Link_Method = l_meth,
        K_Clusters = k,
        Avg_Silhouette = avg_sil,
        Calinski_Harabasz = ch_val,
        Davies_Bouldin = db_val,
        stringsAsFactors = FALSE
      )
      counter <- counter + 1
    }
  }
}

results_df <- do.call(rbind, results_list)
results_df <- results_df %>% 
  filter(!is.na(Calinski_Harabasz)) %>%
  arrange(desc(Calinski_Harabasz))

head(results_df, 10)
##    Dist_Method Link_Method K_Clusters Avg_Silhouette Calinski_Harabasz
## 1    euclidean      ward.D          8      0.3229454          42.56727
## 2    euclidean     ward.D2          7      0.3350730          42.36622
## 3    euclidean     ward.D2          8      0.3197653          42.20434
## 4      maximum      ward.D         12      0.3239288          41.35987
## 5      maximum     ward.D2          3      0.2601840          41.27709
## 6      maximum      ward.D         11      0.3100868          41.12736
## 7    euclidean     ward.D2          6      0.3182528          41.08597
## 8      maximum     ward.D2         13      0.3273877          41.08410
## 9    manhattan      ward.D          7      0.3169714          41.01486
## 10   manhattan     ward.D2          7      0.3169714          41.01486
##    Davies_Bouldin
## 1       0.9287859
## 2       0.8793783
## 3       0.9280217
## 4       0.9282205
## 5       1.2318448
## 6       0.9148007
## 7       0.9932808
## 8       0.9057192
## 9       0.9366231
## 10      0.9366231

Przeprowadzona walidacja metodą Grid Search wyłoniła optymalną konfigurację parametrów, wskazując na zastosowanie miary odległości euklidesowej oraz metody łączenia Warda (wariant D2) przy podziale na 7 skupień. Wybór ten podyktowany jest najlepszym balansem pomiędzy analizowanymi metrykami jakości. Mimo że podział na 8 skupień uzyskał minimalnie wyższy indeks Calińskiego-Harabasza (42,37 dla wybranego modelu wobec 42,57 dla alternatywy), to wybrana konfiguracja dominuje w kluczowych wskaźnikach spójności i separacji. Osiągnięto najwyższy w czołówce rankingowej wskaźnik Silhouette (0,34), co potwierdza większą stabilność przypisania obiektów do grup, oraz najniższą wartość indeksu Daviesa-Bouldina (0,88), dowodzącą lepszego odseparowania klastrów. Przewaga metryki euklidesowej w połączeniu z wariancyjną metodą Warda sugeruje, że o podobieństwie przebiegu pandemii między krajami decyduje całokształt parametrów i ich wzajemne relacje, dążące do tworzenia zwartych, jednorodnych grup, a nie pojedyncze skrajne odchylenia.

final_dist <- dist(df_transformed, method = "euclidean")
final_hc <- hclust(final_dist, method = "ward.D2")
fviz_dend(final_hc, 
          k = 7,
          cex = 0.5,
          k_colors = "jco",
          color_labels_by_k = TRUE,
          rect = TRUE,
          rect_border = "jco",
          rect_fill = TRUE,
          show_labels = FALSE,
          ggtheme = theme_minimal(),
          main = "Dendrogram: Euclidean + Ward.D2 (k=7)"
) +
  labs(y = "Odległość (Wysokość drzewa)")

Wykres wizualizuje proces łączenia obiektów w coraz większe skupienia. Oś pionowa reprezentuje poziom odległości (niepodobieństwa), przy którym następuje fuzja grup – wyższe połączenia świadczą o większym zróżnicowaniu. Kolorowe obszary wyznaczają finalny podział zbioru danych na 7 klastrów, wskazany w procesie walidacji jako zapewniający najlepszy balans między spójnością a separacją grup.

df_final$Cluster <- as.factor(cutree(final_hc, k = 7))
table(df_final$Cluster)
## 
##  1  2  3  4  5  6  7 
## 25 13 13 25  4 11  5

Rozkład liczebności w 7 klastrach: Dane zostały podzielone na 7 grup o zróżnicowanej wielkości. Wyróżnić można trzy typy skupień:

7. Hierarhciczna analiza skupień

cluster_summary <- df_final %>%
  group_by(Cluster) %>%
  summarise(
    Liczba_krajow = n(),
    Mediana_Incidence = median(Incidence_Rate, na.rm = TRUE),
    Mediana_Mortality = median(Mortality_Rate, na.rm = TRUE),
    Mediana_Recovery = median(Recovery_Rate, na.rm = TRUE),
    Mediana_Active = median(Active_Rate, na.rm = TRUE),
    Mediana_Density = median(Density, na.rm = TRUE),
    Mediana_Wiek = median(MedianAge, na.rm = TRUE),
    Mediana_MortalityperCapita = median(Mortality_per_capita, na.rm = TRUE),
    Mediana_stillSickperCapita = median(StillSick_per_capita, na.rm = TRUE)
  )

print(cluster_summary)
## # A tibble: 7 × 10
##   Cluster Liczba_krajow Mediana_Incidence Mediana_Mortality Mediana_Recovery
##   <fct>           <int>             <dbl>             <dbl>            <dbl>
## 1 1                  25       0.00000608            0                0.0588 
## 2 2                  13       0.0000177             0.0223           0.00141
## 3 3                  13       0.00000148            0.0327           0.175  
## 4 4                  25       0.0000385             0                0      
## 5 5                   4       0.000102              0.00234          0.249  
## 6 6                  11       0.000000964           0                0      
## 7 7                   5       0.000210              0.0569           0.0982 
## # ℹ 5 more variables: Mediana_Active <dbl>, Mediana_Density <dbl>,
## #   Mediana_Wiek <dbl>, Mediana_MortalityperCapita <dbl>,
## #   Mediana_stillSickperCapita <dbl>

Poniżej przedstawiono interpretację każdego z 7 klastrów. Należy podkreślić, że analizowane dane obejmują pierwsze dwa miesiące pandemii. Z tego względu wysoki odsetek aktywnych przypadków należy interpretować jako wskaźnik niedawnej introdukcji wirusa do danego kraju (zbyt krótki czas od infekcji, by wystąpił zgon lub wyzdrowienie).

print(df_final$Country.Region[df_final$Cluster == 1])
##  [1] "Afghanistan"          "Australia"            "Belarus"             
##  [4] "Canada"               "Croatia"              "Finland"             
##  [7] "Georgia"              "Jamaica"              "Jordan"              
## [10] "Kuwait"               "Latvia"               "Lithuania"           
## [13] "Malaysia"             "Mexico"               "North Macedonia"     
## [16] "Oman"                 "Pakistan"             "Romania"             
## [19] "Russia"               "Saudi Arabia"         "Senegal"             
## [22] "Serbia"               "Sri Lanka"            "United Arab Emirates"
## [25] "Vietnam"
print(df_final$Country.Region[df_final$Cluster == 2])
##  [1] "Albania"        "Bulgaria"       "Ecuador"        "France"        
##  [5] "Greece"         "Lebanon"        "Luxembourg"     "Martinique"    
##  [9] "Netherlands"    "Panama"         "Philippines"    "US"            
## [13] "United Kingdom"
print(df_final$Country.Region[df_final$Cluster == 3])
##  [1] "Algeria"    "Argentina"  "Azerbaijan" "Egypt"      "Hungary"   
##  [6] "India"      "Indonesia"  "Iraq"       "Japan"      "Morocco"   
## [11] "Poland"     "Taiwan*"    "Thailand"
print(df_final$Country.Region[df_final$Cluster == 4])
##  [1] "Armenia"                "Austria"                "Belgium"               
##  [4] "Bosnia and Herzegovina" "Brunei"                 "Chile"                 
##  [7] "Costa Rica"             "Cyprus"                 "Czechia"               
## [10] "Denmark"                "Estonia"                "French Guiana"         
## [13] "Germany"                "Iceland"                "Ireland"               
## [16] "Israel"                 "Maldives"               "Moldova"               
## [19] "Norway"                 "Portugal"               "Qatar"                 
## [22] "Slovakia"               "Slovenia"               "Sweden"                
## [25] "Switzerland"
print(df_final$Country.Region[df_final$Cluster == 5])
## [1] "Bahrain"      "Korea, South" "Malta"        "Singapore"
print(df_final$Country.Region[df_final$Cluster == 6])
##  [1] "Bolivia"            "Brazil"             "Burkina Faso"      
##  [4] "Colombia"           "Dominican Republic" "Kazakhstan"        
##  [7] "Peru"               "South Africa"       "Tunisia"           
## [10] "Turkey"             "Venezuela"
print(df_final$Country.Region[df_final$Cluster == 7])
## [1] "China"      "Iran"       "Italy"      "San Marino" "Spain"
df_map_plotly <- df_final %>%
  mutate(
    Cluster_Num = as.numeric(as.character(Cluster)),
    Hover_Text = paste0(
      "<b>", Country.Region, "</b>",
      "<br>Klaster: ", Cluster,
      "<br>Śmiertelność: ", round(Mortality_Rate * 100, 2), "%",
      "<br>Gęstość: ", round(Density, 0)
    )
  )

g <- list(
  showframe = FALSE,
  showcoastlines = TRUE,
  projection = list(type = 'natural earth')
)

fig <- plot_geo(df_map_plotly) %>%
  add_trace(
    z = ~Cluster_Num,
    locations = ~Iso3,
    locationmode = 'ISO-3',
    colors = "Set1",
    marker = list(
      line = list(color = "white", width = 0.5)
    ),
    text = ~Hover_Text,
    hoverinfo = "text",
    type = 'choropleth',
    showscale = FALSE
  ) %>%
  layout(
    title = '<b>Rozkład klastrów COVID-19 (Wypełnienie)</b>',
    geo = g
  )

fig
pca_data <- df_transformed
pca_result <- prcomp(pca_data, scale. = FALSE)

fviz_cluster(list(data = pca_data, cluster = df_final$Cluster),
             geom = "point",
             ellipse.type = "convex", 
             palette = "Set1",
             ggtheme = theme_minimal(),
             main = "Wizualizacja separacji klastrów (PCA)")

Wykres prezentuje wizualizację wyników grupowania w przestrzeni dwóch pierwszych składowych głównych (PCA), które łącznie wyjaśniają 63,9% zmienności w zbiorze danych. Wymiar pierwszy odpowiada za 35,6% informacji, a drugi za 28,3%, co pozwala na wiarygodną ocenę relacji między grupami na płaszczyźnie. Rozmieszczenie punktów wskazuje na wyraźną separację klastrów peryferyjnych (np. grupy 4, 5 i 6), które zajmują odrębne obszary, co potwierdza ich unikalną charakterystykę. W centrum wykresu widoczne jest częściowe nakładanie się klastrów 1 i 2, co sugeruje istnienie państw o cechach przejściowych. Mimo to większość grup tworzy zwarte skupiska, co dowodzi wysokiej jednorodności wewnątrz klastrów i potwierdza zasadność przyjętego podziału na 7 grup.

8. Algorytm K-średnich

W celu weryfikacji wyników uzyskanych metodą hierarchiczną oraz sprawdzenia stabilności wyodrębnionych struktur, w drugim etapie analizy zastosowano algorytm niehierarchiczny (podziałowy). Opracowano skrypt iteracyjny dla metody K-średnich (K-Means), który automatycznie testuje jakość podziału w poszukiwaniu optymalnej liczby skupień.

Procedura badawcza obejmowała:

set.seed(2022)

kmeans_results <- data.frame()
dist_matrix <- dist(df_transformed)

for (k in 2:20) {
  set.seed(123)
  km_fit <- kmeans(df_transformed, centers = k, nstart = 25)
  
  sil <- silhouette(km_fit$cluster, dist_matrix)
  sil_val <- mean(sil[, 3])
  
  ch_val <- calinhara(df_transformed, km_fit$cluster)
  
  centers <- km_fit$centers
  cluster_indices <- km_fit$cluster
  scatters <- numeric(k)
  
  for(i in 1:k) {
    cluster_data <- df_transformed[cluster_indices == i, , drop=FALSE]
    if(nrow(cluster_data) > 0) {
      dists_to_center <- sqrt(rowSums(sweep(cluster_data, 2, centers[i,], "-")^2))
      scatters[i] <- mean(dists_to_center)
    } else {
      scatters[i] <- 0
    }
  }
  
  center_dists <- as.matrix(dist(centers))
  
  R <- matrix(0, nrow = k, ncol = k)
  for(i in 1:k) {
    for(j in 1:k) {
      if(i != j) {
        R[i, j] <- (scatters[i] + scatters[j]) / center_dists[i, j]
      }
    }
  }
  db_val <- mean(apply(R, 1, max))
  
  kmeans_results <- rbind(kmeans_results, data.frame(
    K_Clusters = k,
    Avg_Silhouette = round(sil_val, 4),
    Calinski_Harabasz = round(ch_val, 2),
    Davies_Bouldin = round(db_val, 4)
  ))
}

kmeans_sorted <- kmeans_results[order(-kmeans_results$Avg_Silhouette), ]
head(kmeans_sorted, 10)
##    K_Clusters Avg_Silhouette Calinski_Harabasz Davies_Bouldin
## 6           7         0.3590             45.65         0.8623
## 7           8         0.3506             46.71         0.9169
## 5           6         0.3427             44.10         0.9576
## 8           9         0.3406             45.72         0.9382
## 13         14         0.3329             42.75         0.8937
## 9          10         0.3323             44.96         0.9361
## 15         16         0.3312             41.77         0.8869
## 14         15         0.3298             41.60         0.8948
## 12         13         0.3252             43.04         0.9237
## 11         12         0.3235             42.85         0.9228

Przeprowadzona walidacja metodą niehierarchiczną (K-Means) wyłoniła optymalną konfigurację podziału, wskazując na zasadność wyodrębnienia 7 skupień. Wybór ten podyktowany jest najlepszym balansem pomiędzy analizowanymi metrykami jakości, gdzie wariant ten wykazuje przewagę nad alternatywnymi podziałami w kluczowych aspektach spójności i separacji. Mimo że podział na 8 skupień uzyskał minimalnie wyższy indeks Calińskiego-Harabasza (46,71 dla alternatywy wobec 45,65 dla wybranego modelu), to konfiguracja 7-elementowa dominuje w pozostałych wskaźnikach decydujących o jakości klasteryzacji. Osiągnięto najwyższy w całym zestawieniu wskaźnik Silhouette (0,36), co potwierdza największą stabilność przypisania państw do grup, oraz najniższą wartość indeksu Daviesa-Bouldina (0,86), dowodzącą najlepszego odseparowania klastrów od siebie. Uzyskany wynik stanowi silną walidację krzyżową dla wcześniejszego modelu hierarchicznego (metoda Warda), który również wskazywał na istnienie 7 unikalnych wzorców przebiegu pandemii. Konwergencja wyników dwóch odmiennych matematycznie podejść – aglomeracyjnego (hierarchicznego) i podziałowego (K-Means) – sugeruje, że wyodrębniona struktura nie jest artefaktem obliczeniowym, lecz odzwierciedla naturalne, rzeczywiste zróżnicowanie strategii i skutków walki z wirusem w analizowanych krajach.

set.seed(2022)

kmeans_final <- kmeans(df_transformed, centers = 7, nstart = 25)

df_final$Cluster_kmeans <- as.factor(kmeans_final$cluster)

print(table(df_final$Cluster_kmeans))
## 
##  1  2  3  4  5  6  7 
## 24 17  5  4 13 23 10

Analiza liczebności grup w modelu K-Means wykazuje zbliżoną strukturę do modelu hierarchicznego, z wyraźnym podziałem na trzon analizy oraz grupy skrajne, jednak z lekkim przesunięciem akcentów w grupach średnich.

cluster_kmeans_summary <- df_final %>%
  group_by(Cluster_kmeans) %>%
  summarise(
    Liczba_krajow = n(),
    Mediana_Incidence = median(Incidence_Rate, na.rm = TRUE),
    Mediana_Mortality = median(Mortality_Rate, na.rm = TRUE),
    Mediana_Recovery = median(Recovery_Rate, na.rm = TRUE),
    Mediana_Active = median(Active_Rate, na.rm = TRUE),
    Mediana_Density = median(Density, na.rm = TRUE),
    Mediana_Wiek = median(MedianAge, na.rm = TRUE),
    Mediana_MortalityperCapita = median(Mortality_per_capita, na.rm = TRUE),
    Mediana_stillSickperCapita = median(StillSick_per_capita, na.rm = TRUE)
  )

print(cluster_kmeans_summary)
## # A tibble: 7 × 10
##   Cluster_kmeans Liczba_krajow Mediana_Incidence Mediana_Mortality
##   <fct>                  <int>             <dbl>             <dbl>
## 1 1                         24        0.00000699           0      
## 2 2                         17        0.00000104           0      
## 3 3                          5        0.000210             0.0569 
## 4 4                          4        0.000102             0.00234
## 5 5                         13        0.0000137            0.0303 
## 6 6                         23        0.0000921            0      
## 7 7                         10        0.00000144           0.0336 
## # ℹ 6 more variables: Mediana_Recovery <dbl>, Mediana_Active <dbl>,
## #   Mediana_Density <dbl>, Mediana_Wiek <dbl>,
## #   Mediana_MortalityperCapita <dbl>, Mediana_stillSickperCapita <dbl>

9. Analiza skupień k-średnich

Poniżej przedstawiono interpretację każdego z 7 klastrów uzyskanych w wyniku metody k-means. Należy podkreślić, że analizowane dane obejmują pierwsze dwa miesiące pandemii. Z tego względu wysoki odsetek aktywnych przypadków należy interpretować jako wskaźnik niedawnej introdukcji wirusa do danego kraju (zbyt krótki czas od infekcji, by wystąpił zgon lub wyzdrowienie).

print(df_final$Country.Region[df_final$Cluster_kmeans==1])
##  [1] "Afghanistan"          "Australia"            "Belarus"             
##  [4] "Canada"               "Croatia"              "Finland"             
##  [7] "Georgia"              "Jamaica"              "Jordan"              
## [10] "Kuwait"               "Latvia"               "Lithuania"           
## [13] "Malaysia"             "Mexico"               "North Macedonia"     
## [16] "Oman"                 "Romania"              "Russia"              
## [19] "Senegal"              "Serbia"               "Sri Lanka"           
## [22] "Thailand"             "United Arab Emirates" "Vietnam"
print(df_final$Country.Region[df_final$Cluster_kmeans==2])
##  [1] "Bolivia"                "Bosnia and Herzegovina" "Brazil"                
##  [4] "Burkina Faso"           "Chile"                  "Colombia"              
##  [7] "Costa Rica"             "Dominican Republic"     "Kazakhstan"            
## [10] "Moldova"                "Pakistan"               "Peru"                  
## [13] "Saudi Arabia"           "South Africa"           "Tunisia"               
## [16] "Turkey"                 "Venezuela"
print(df_final$Country.Region[df_final$Cluster_kmeans==3])
## [1] "China"      "Iran"       "Italy"      "San Marino" "Spain"
print(df_final$Country.Region[df_final$Cluster_kmeans==4])
## [1] "Bahrain"      "Korea, South" "Malta"        "Singapore"
print(df_final$Country.Region[df_final$Cluster_kmeans==5])
##  [1] "Albania"        "Argentina"      "Bulgaria"       "Ecuador"       
##  [5] "France"         "Hungary"        "Lebanon"        "Martinique"    
##  [9] "Netherlands"    "Panama"         "Philippines"    "US"            
## [13] "United Kingdom"
print(df_final$Country.Region[df_final$Cluster_kmeans==6])
##  [1] "Armenia"       "Austria"       "Belgium"       "Brunei"       
##  [5] "Cyprus"        "Czechia"       "Denmark"       "Estonia"      
##  [9] "French Guiana" "Germany"       "Greece"        "Iceland"      
## [13] "Ireland"       "Israel"        "Luxembourg"    "Maldives"     
## [17] "Norway"        "Portugal"      "Qatar"         "Slovakia"     
## [21] "Slovenia"      "Sweden"        "Switzerland"
print(df_final$Country.Region[df_final$Cluster_kmeans==7])
##  [1] "Algeria"    "Azerbaijan" "Egypt"      "India"      "Indonesia" 
##  [6] "Iraq"       "Japan"      "Morocco"    "Poland"     "Taiwan*"
df_map_plotly <- df_final %>%
  mutate(
    Cluster_Num = as.numeric(as.character(Cluster_kmeans)),
    Hover_Text = paste0(
      "<b>", Country.Region, "</b>",
      "<br>Klaster: ", Cluster_kmeans,
      "<br>Śmiertelność: ", round(Mortality_Rate * 100, 2), "%",
      "<br>Gęstość: ", round(Density, 0)
    )
  )

g <- list(
  showframe = FALSE,
  showcoastlines = TRUE,
  projection = list(type = 'natural earth')
)

fig <- plot_geo(df_map_plotly) %>%
  add_trace(
    z = ~Cluster_Num,
    locations = ~Iso3,
    locationmode = 'ISO-3',
    colors = "Set1",
    marker = list(
      line = list(color = "white", width = 0.5)
    ),
    text = ~Hover_Text,
    hoverinfo = "text",
    type = 'choropleth',
    showscale = FALSE
  ) %>%
  layout(
    title = '<b>Rozkład klastrów COVID-19 (K-means)</b>',
    geo = g
  )

fig
pca_data <- df_transformed
pca_result <- prcomp(pca_data, scale. = FALSE)

fviz_cluster(list(data = pca_data, cluster = df_final$Cluster_kmeans),
             geom = "point",
             ellipse.type = "convex", 
             palette = "Set1",
             ggtheme = theme_minimal(),
             main = "Wizualizacja separacji klastrów (PCA) z K-means")

Wykres prezentuje rzutowanie wyników grupowania metodą K-średnich na przestrzeń dwuwymiarową, przy zachowaniu 63,9% całkowitej zmienności danych. Wizualizacja uwidacznia charakterystyczną dla tego algorytmu tendencję do tworzenia zwartych i geometrycznie regularnych skupień. Analiza przestrzenna potwierdza wysoką jakość podziału, gdzie grupy peryferyjne są wyraźnie odseparowane od reszty stawki, co świadczy o ich unikalnym profilu. W centralnym zagęszczeniu wykresu algorytm wyznaczył ostre granice między grupami dominującymi, minimalizując strefy nakładania się, co potwierdza stabilność wyodrębnionych wzorców epidemicznych i zasadność przyjęcia modelu siedmioelementowego.

10. Porównanie modeli i wnioski końcowe

Celem niniejszego badania była identyfikacja ukrytych struktur w danych dotyczących wczesnej fazy pandemii COVID-19 (styczeń-marzec 2020) przy użyciu metod uczenia nienadzorowanego. Przeprowadzono analizę porównawczą dwóch odmiennych podejść: hierarchicznej analizy skupień (metoda aglomeracyjna) oraz algorytmu K-średnich (metoda podziałowa).

Podsumowując, analiza skupień skutecznie zredukowała złożoność wielowymiarowych danych epidemicznych, pozwalając na kategoryzację 96 państw do 7 czytelnych profili, co ułatwia zrozumienie globalnej dynamiki zagrożenia w początkowej fazie kryzysu.